KP25 G 1 ;SEQUENTIEEL WIJZIGEN PROODUKTEN VOLGENS HG-GR-SG-MK-PR (scherm 1-X wijzigen) ; Quit naar KP22 [ 03/16/95  10:56 AM ]
 ;
SC S PCC=$$COMPR^PRODUKT(PR)
 Q
 ;
SPC S PNC=$$TRIMIDENT^vhRtn1(PNC) ;[IDENT] CW
 S PNC=PNC_" "
 Q
 ;
1 K A S KMN="",ULN=4,FP=401 W @F,@F1 S FP=480 W @F,@F5
23 S FP=402 W @F,@F4,"REF. LEV.| PRODUKTNAAM              | ",$P(U2,U,1),$E(BLA,1,39-$L($P(U2,U,1))),@F5
25 S PVNR=$N(@("^"_Q_"PWSVN(PVNR)")) G YZ:PVNR=-1!(PVNR]PLNR) S PR=^(PVNR)
27 L @("^"_Q_"PR(PR)"):2 E  S FP=2403+F60 W @F,@F2,@F4,"PRODUKT ",$P(@("^"_Q_"PR(PR,0)"),D,1)," IS IN GEBRUIK [] = OK ",@F5,@F0 R K G 27
28 K B S PLF="",B(1)=@("^"_Q_"PR(PR,0)") F I=1:1:6 I $D(^(I)) S B(I+1)=^(I)
29 I $P(B(2),D,25) G 25:K'="-" S PVNR=PVNR-2 G YZ:PVNR<0!(PVNR<PFNR),25
30 I $E($N(^("J")),1)="J" S PLF=$P(^($N(^("J"))),D,3)
31 S X=$P(U2,U,16),U3=$P(B(X\100),D,X#100),K=U3 X:$L($P(U2,U,8)) "S U3="_$P(U2,U,8) I U7=101 S PC=$P(B(1),D,1) D SC S OCC=PCC
32 I U7=325 S PNC=$P(B(3),D,25) D SPC S OPNC=PNC
33 S ULN=ULN+1 I ULN>19 S FP=ULN*100+1 W @F,@F1 S ULN=ULN-1,FP=501 W @F,@FDL
35 S FP=ULN*100+2 W @F,@F1,$E(PLF,1,10) S FP=FP+10 W @F,"| ",$E($P(B(1),D,1),1,25) S FP=FP+27 W @F,"| ",U3
36 I $P(U2,U,12),@$P(U2,U,15) G 41:KMN="-" S FP=2403+F60 W @F,@F2,@F4,"NIET WIJZIGBAAR [] = OK ",@F5,@F0 R K G 25:K'="-" S KMN=K G 41
37 I $L($P(U2,U,19)),@$P(U2,U,20) X $P(U2,U,19) S:K="I" K=KMN S KMN=K G YZ:K=",",25:K=".",41:K="-",55
370 S FP=2103+F60 W @F,@F1,$P(U2,U,1)," : ",$E(PNT,1,$P(U2,U,9)) W:$L($P(U2,U,10)) !?2,$P(U2,U,10)
39 W !?2,"-[] = vorig produkt   .[] = volgend produkt   I[] = idem met vorige input"
40 S FP=2100+F60+($L($P(U2,U,1))+6) W @F,@F0 R K S:K="I" K=KMN S KMN=K G 40:K?.E1C.E,YZ:K=",",25:K=".",43:K'="-"
41 S PVNR=PVNR-2 G YZ:PVNR<0!(PVNR<PFNR) S ULN=ULN-2 S:ULN<4 ULN=4 G 25
43 G 47:$P(U2,U,11)'="DCTR" S KD=$P(K,".",1),KM=$P(K,".",2),KJ=$P(K,".",3)
45 G 55:K?2N1"."2N1"."2N&(KD>0)&(KM>0)&(KD<32)&(KM<13)&'("04060911"[KM&(KD=31))&'(+KM=2&(('(KJ#4)&(KD>29))!(KJ#4&(KD>28)))),37
47 I "\102\111\222\421\302\423\501\502\503\504\505\506\"[(D_$P(U2,U,16)_D),K="" G 37
48 S X=$P(U2,U,11)_"&'(K[D)&($L(K)'>$P(U2,U,9))"
49 I @X G 55:U7'=101,37:K="" S PC=K D SC G 53:$D(@("^"_Q_"PR1(PCC)"))&(OCC'=PCC),54
51 G 37
53 S FP=2403+F60 W @F,@F4,"DEZE PRODUKTKODE BESTAAT REEEDS [] = OK ",@F5,@F2,@F0 R K G 37
54 K @("^"_Q_"PR1(OCC)") S ^(PCC)=PR_D_PC,VNR=$P(@("^"_Q_"PWSPC(OCC)"),D,3) K ^(OCC) S ^(PCC)=PR_D_PC_D_VNR,I1=PR D ^cPE310 G 56
55 G 56:U7'=325,37:K="" S PNC=K D SPC I $D(@("^"_Q_"PR2(PNC)"))&(OPNC'=PNC) X ^cTXT(0,"N",12) R K G 37
550 K @("^"_Q_"PR2(OPNC)") S ^(PNC)=PR_D_K
552 G 56:'$D(@("^"_Q_"PR(PR,""J5005"")")) S PLF=^("J5005"),^("J5005")=$P(PLF,D,1,2)_D_$P(K,".",2,99)_D_$P(PLF,D,4,99),PC=$P(B(1),D,1) D SC
554 S PLR=$P(PLF,D,1)_" ",PLM=$P(PLF,D,2)_" ",PLF=$P(PLF,D,3)_" ",@("^"_Q_"PL(PLR,PLM,$P(K,""."",2,99)_"" "",PCC)")=PR K @("^"_Q_"PL(PLR,PLM,PLF,PCC)"),PLR,PLM,PLF
556 S FP=ULN*100+2 W @F,$E(K,3,11)
56 S U3=K X:$L($P(U2,U,8)) "S U3="_$P(U2,U,8) S FP=ULN*100+41 W @F,@F2,U3
57 S X=$P(U2,U,16)\100,Y=$P(U2,U,16)#100 S:(Y-1) K=D_K S B(X)=$P(B(X),D,1,Y-1)_K_D_$P(B(X),D,Y+1,99)
 D DELIND^PRODUKT2(PR)
59 S X="^"_Q_"PR(PR,0)=B(1)",@X F I=1:1:6 I $D(^(I)) S ^(I)=B(I+1)
 D BLDIND^PRODUKT2(PR)
 I $D(X3) D @X3
61 G 25
 ;
YZ K A Q
 ;
 Q
Z X ^cZ Q
ZZ ; 21.04.88 - 12 u 32