cPE73 G 1 ;BEHEER VERVANGINGSNUMMERS ;%PE71;
 ;
ER G ^II:$ZE["<INTERRUPT>",^cER
 ;
S3 I $S>1200 Q
S31 F X=0:1:ST-1 X SX(X)
S32 S:$D(S(ST)) S(0)=S(ST) K S(ST) S ST=0 K SX
S3Z Q
 ;
1 S ST=0,S0=@Q2,SC="L",PST=$P(S0,D,14),PY=$P(S0,D,17),PH=$P(^(1),D,11)
60 S SX(ST)="S "_Q2_"="""_$P(S0,D,1,8)_"\2\"_$P(S0,D,10,13)_"\0\"_$P(S0,D,15)_D_DT_"\0\"_$P(S0,D,18,22)_D_PR2_D_$P(S0,D,24,99)_""""
61 S ST=ST+1 G 68:PH
 ;
62 S SA=(DJ#100)_DM_DD_6_PST_"#0"_"##"_D,S=1 I $D(^("H")) S S=^("H"),S(ST)=^("H"_$E("000",1,3-$L(S))_S) G 66:$L(S(ST)_SA)<240 S S=S+1
64 S SX(ST)="S ^(""H"")="""_S_"""",S(ST)="",ST=ST+1,S(ST)=""
66 S SX(ST)="S ^(""H"_$E("000",1,3-$L(S))_S_""")="""_S(ST)_SA_"""",S(ST)="",ST=ST+1
 ;
68 D S3 S SC=$N(^(SC)) I SC=-1 D S31 G 72
70 S S1(SC)=^(SC) G 68:$E(SC,1)="V" S SX(ST)="K ^("""_SC_""")",ST=ST+1 G 68
 ;
72 S S1=@Q3,SC="L",PH=$P(^(1),D,11)
74 D S3 S SX(ST)="S "_Q3_"="""_$P(S1,D,1,13)_D_($P(S1,D,14)+PST)_D_$P(S1,D,15,16)_D_($P(S1,D,17)+PY)_D_$P(S1,D,18,99)_""""
76 S ST=ST+1 D S3 S SX(ST)="S ^(""V"_PR_""")=""""",ST=ST+1 G 83:PH
 ;
78 S SA=(DJ#100)_DM_DD_5_PST_"#0"_"##"_D,S=1 I $D(^("H")) S S=^("H"),S(ST)=^("H"_$E("000",1,3-$L(S))_S) G 82:$L(S(ST)_SA)<240 S S=S+1
80 D S3 S SX(ST)="S ^(""H"")="""_S_"""",S(ST)="",ST=ST+1,S(ST)=""
82 D S3 S SX(ST)="S ^(""H"_$E("000",1,3-$L(S))_S_""")="""_S(ST)_SA_"""",S(ST)="",ST=ST+1
 ;
83 S S=""
84 S SC=$N(S1(SC)) G 104:SC=-1,86:$E(SC,1)="L",92:$E(SC,1)="S",98:$E(SC,1)="T",84
86 S SA=$E(SC,1,7)
88 I $D(^(SA_S)) S S=S+1 G 88
90 D S3 S SX(ST)="S ^("""_SA_S_""")="""_S1(SC)_"""",ST=ST+1,S=S+1 G 84
92 S SB=S1(SC) I '$D(^(SC)) G 96
94 S SA=^(SC),SB=($P(SB,D,1)+$P(SA,D,1))_D_$P(SB,D,2,99) F X=2:1:10 S SB=$P(SB,D,1,X-1)_D_($P(SB,D,X)+$P(SA,D,X))_D_$P(SB,D,X+1,99)
96 D S3 S SX(ST)="S ^("""_SC_""")="""_SB_"""",ST=ST+1 G 84
98 S SB=S1(SC) I '$D(^(SC)) G 102
100 S SA=^(SC) S SB=$P(SB,D,1,3)_D_($P(SB,D,4)+$P(SA,D,4))_D_($P(SB,D,5)+$P(SA,D,5))_D_$P(SB,D,6,99)
102 D S3 S SX(ST)="S ^("""_SC_""")="""_SB_"""",ST=ST+1 G 84
 ;
104 F X=0:1:ST-1 X SX(X)
106 K S,S0,S1,SA,SB,ST,SX
108 D ^cPE74 S @%Q1=1 G 59^cPE72
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ; 02.05.86 - 11 u 53