cI58 ;AANPASSING FICHE IVM USL ;%I58; [ 12/02/92  6:07 PM ]
 G 1
 ;
 ; bonniveau
S1 S ANR=0
S1A S ANR=$O(@("^"_Q_UPW_"(ANR)")) G S1Z:ANR="" S US=VUS I $D(@("^"_Q_UPW_"(ANR,US)")) G S1C
S1B S US=$O(@("^"_Q_UPW_"(ANR,US)")) G S1A:$E(US,1,$L(VUS))'=VUS
S1C I $L(US)'<$L(NUS),$E(US,1,$L(NUS))=NUS G S1A
S1D I $D(^(US)) S K=^(US) K ^(US) S ^(NUS_$E(US,$L(VUS)+1,99))=K
S1E G S1B
S1Z Q
 ;
 ; detail
S2 S ANR=0
S2A S ANR=$O(@("^"_Q_UPW_"(ANR)")) G S2Z:ANR="" S IND=18000000
S2B S IND=$O(@("^"_Q_UPW_"(ANR,IND)")) G S2A:IND'?8N S US=VUS I $D(@("^"_Q_UPW_"(ANR,IND,US)")) G S2D
S2C S US=$O(@("^"_Q_UPW_"(ANR,IND,US)")) G S2B:$E(US,1,$L(VUS))'=VUS
S2D I $L(US)'<$L(NUS),$E(US,1,$L(NUS))=NUS G S2B
S2E S IND2=""
S2F S IND2=$O(@("^"_Q_UPW_"(ANR,IND,US,IND2)")) G S2C:IND2=""
S2G I $D(^(IND2)) S K=^(IND2) K ^(IND2) S @("^"_Q_UPW_"(ANR,IND,NUS_$E(US,$L(VUS)+1,99),IND2)")=K
S2H G S2F
S2Z Q
 ;
 ; toestellen ( US = van UZ\ naar UZ)
 ; parameter ^QPWFN(0,T,USL) = lengte US-1
1 S @("^"_Q_"PWFN(0,""T"",""USL"")")=1 F UPW="PWT" F US="R\RT","Z\ZZ" S VUS=$P(US,D),NUS=$P(US,D,2) W !,UPW,"-",US D S1,S2
 ;
YZ Q
 ;
Z X ^cZ
ZZ ; 02.12.92 - 18 u 10 *