KPE310 G 1 ;WIJZIGEN PRODUKTENKODE IN INDEXBESTANDEN ;KPE30; overlay van KPE31 [ 09/28/93  11:24 AM ]
 ;
T1 ;BESTANDEN IN GEBRUIK 
T2 ;WIJZIGEN PRODUKTKODE
 ;
1000 S X4=$E(X1,2,99),X4=$P(@("^"_Q_"PR(X4,0)"),D,1)
 S X6=$$COMPRES^PRODUKT(X4,SRTKEYKT)
1010 Q
 ;
2000 S X5=X5+1,FP=2240 W @F,$J(X5,6) Q
 ;
ER G ^II:$ZE["<INTERRUPT>",^cER
 ;
1 L (@("^"_Q_"PR1(PCC)"),@("^"_Q_"PR(I1)"),@("^"_Q_"PR1(OCC)"),@("^"_Q_"PD"),@("^"_Q_"PL"),@("^"_Q_"PH"),@("^"_Q_"PM")):2 E  S FP=2403 W @F,@F2,@F4,$P($T(T1),U,2),@F5 H 2 G 1
5 S FP=2203 W @F,@F1,$P($T(T2),U,2)
 ;
7 S X1="I",(XSW,X5)=0,(Y1,Y2,Y3)="  "
10 S X1=$N(@("^"_Q_"PR(I1,X1)")) G 200:$E(X1,1)'="I"&XSW,20:$E(X1,1)'="I" F I=1:1:3 S @("Y"_I)=$P(^(X1),D,I)
20 S X2="J",XSW=1,(Y4,Y5,Y6)="  ",XSJ=0
30 S X2=$N(@("^"_Q_"PR(I1,X2)")) G 10:$E(X2,1)'="J"&XSJ,40:$E(X2,1)'="J" F I=1:1:3 S @("Y"_(I+3))=$P(^(X2),D,I)_" "
40 K @("^"_Q_"PL(Y4,Y5,Y6,OCC)"),@("^"_Q_"PM(Y5,Y1,Y2,Y3,OCC)"),@("^"_Q_"PH(Y1,Y2,Y3,Y5,OCC)") D 2000
50 S (@("^"_Q_"PL(Y4,Y5,Y6,PCC)"),@("^"_Q_"PM(Y5,Y1,Y2,Y3,PCC)"),@("^"_Q_"PH(Y1,Y2,Y3,Y5,PCC)"))=I1,XSJ=1 G 30
 ;
200 S X1="D"
210 S X1=$N(@("^"_Q_"PR(I1,X1)")) G 220:$E(X1,1)'="D" D 1000 S X4=@("^"_Q_"PD(OCC,X6)") K ^(X6) S @("^"_Q_"PD(PCC,X6)")=X4 D 2000 G 210
220 S X1="E"
230 S X1=$N(@("^"_Q_"PR(I1,X1)")) G YZ:$E(X1,1)'="E" D 1000 S X4=@("^"_Q_"PD(X6,OCC)") K ^(OCC) S @("^"_Q_"PD(X6,PCC)")=X4 D 2000 G 230
 ;
YZ K X1,X2,X6,X4,X5,Y1,Y2,Y3,Y4,Y5,Y6,XSW,XSJ L (@("^"_Q_"PR(I1)"),@("^"_Q_"PR1(PCC)")) Q
 ;
Z X ^cZ
ZZ ; 16.12.85 - 15 u 14