cI52 ;COPIEREN GEGEVENS UIT 'Q'_UGL NAAR ANDERE FAKTURATIESOORT ; [ 12/02/92  4:51 PM ]
 G YZ
 ;
UL S UGL="UL",UG1="U1",UG2="U2",UGB="UB" G 1
OD S UGL="OD",UG1="O1",UG2="O2",UGB="OB" G 1
 ;
T1 ;OORSPR. FAKTURATIESOORT;
T2 ;NIEUWE FAKTURATIESOORT ;
T3 ;GEGEVENS OK\".[] = ok   ,[] = hernemen";
T4 ;NUL-NODES COPIEREN\"[] = neen   1[] = ja";
 ;
1 S K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
11 S R="US\20\3\"_$P($T(T1),U,2)_"\\2\\$L(K)" D ^cA100 G YZ:K="-"
13 S R="USN\21\3\"_$P($T(T2),U,2)_"\\2\\$L(K)" D ^cA100 G 11:K="-"
15 S R="NUL\22\3\"_$P($T(T4),U,2)_"\1\\"",-1""[K" D ^cA100 G 13:K="-",11:K=","
17 S R="K\23\3\"_$P($T(T3),U,2)_"\1\\"",-.""[K&$L(K)" D ^cA100 G 15:K="-",11:K=","
 ;
 ;overzetten UGL
2 S KC=0
21 S KC=$O(@("^"_Q_UGL_"(KC)")) G 3:'KC S UR="" S FP=2403 W @F,KC,@F2
23 S UR=$O(@("^"_Q_UGL_"(KC,US,UR)")),UZ="" I '$L(UR) K @("^"_Q_UGL_"(KC,US)") G 21
25 S UZ=$O(@("^"_Q_UGL_"(KC,US,UR,UZ)")) G 23:'$L(UZ) S @("^"_Q_UGL_"(KC,USN,UR,UZ)")=^(UZ) G 25
 ;
 ;overzetten UG1
3 S UR=""
31 S UR=$O(@("^"_Q_UG1_"(US,UR)")) G 39:'$L(UR) S @("^"_Q_UG1_"(USN,UR)")=^(UR),I3="",FP=2403 W @F,UR,@F2
33 S I3=$O(@("^"_Q_UG1_"(US,UR,I3)")) G 31:'$L(I3) S @("^"_Q_UG1_"(USN,UR,I3)")=^(I3) G 33
39 K @("^"_Q_UG1_"(US)")
 ;
 ;overzetten UG2
4 S KC=""
41 S KC=$O(@("^"_Q_UG2_"(US,KC)")) G 49:'$L(KC) S UR="",FP=2403 W @F,KC,@F2
43 S UR=$O(@("^"_Q_UG2_"(US,KC,UR)")) G 41:'$L(UR) S @("^"_Q_UG2_"(USN,KC,UR)")=^(UR) G 43
49 K @("^"_Q_UG2_"(US)")
 ;
 ;overzetten UGB
5 S UR=""
51 S UR=$O(@("^"_Q_UGB_"(US,UR)")) G 59:'$L(UR) S @("^"_Q_UGB_"(USN,UR)")=^(UR),FP=2403 W @F,UR,@F2 G 51
59 K @("^"_Q_UGB_"(US)") G YZ:UGL'="UL"
 ;
 ;overzetten FA
6 S FNR=""
61 S FNR=$O(@("^"_Q_"FA(US,FNR)")) G 7:'FNR S I3="",FP=2403 W @F,FNR,@F2
63 S I3=$O(@("^"_Q_"FA(US,FNR,I3)")),I4="" I '$L(I3) K @("^"_Q_"FA(US,FNR)") G 61
65 S I4=$O(@("^"_Q_"FA(US,FNR,I3,I4)")) G 63:'$L(I4) S @("^"_Q_"FA(USN,FNR,I3,I4)")=^(I4) G 65
 ;
 ;overzetten nul-node
7 G YZ:'NUL S I3="" F  S I3=$O(@("^"_Q_UGL_"(0,US,I3)")) Q:'$L(I3)  S X=^(I3) K ^(I3) S @("^"_Q_UGL_"(0,USN,I3)")=X
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ;