KOF2B G 1 ;OFFERTE MODULE WIJZIGEN MANUELE LIJN; Do naar KOF1925A - Quit naar KOF2 [ 06/16/94  11:42 AM ]
 ;
S4 S FP=FP W @F,@F2
S4Z Q
 ;
1 S UUV=1,(UVM,UMC)=$P(@("^"_Q_UGL_"(KC,US,UR,1)"),D,18)
3 S (PID,X)=$P(U2,D,20) G ^KOF2C:'$L(PID) D SCROL^READ("IDENTNUMMER",11,X,"","","","",19,3) G YZ:K="-",31:K=""
5 S SID=$E(K,3,5)_$E(K,7,8) D S3 G 30:SCD=$E(K,9) S K="-.---.---.-",FP=1917+F60 W @F,@F2,K
30 S PID=K,X=$P(K,".",1)_$P(K,".",2)_$P(K,".",3)_$P(K,".",4)_" " I $D(@("^"_Q_"PR2(X)")) D M1 G 3
31 S (UC,X)=$P(U2,D,5) D SCROL^READ("PRODUKTNAAM",25,X,"","","","",22,3)
 G 3:K="-"!(K=","),33:K="" S UC=K F I=1:1:21 Q:$E(UC,I)'=" "  S K=$E(K,2,99)
32 I '$L(K)!(K=$E(UC,22,25)) S UC="     -"_$E(UC,7,99),FP=2217+F60 W @F,@F2,UC
33 S (PN1,X)=$P(U2,D,29) D SCROL^READ("OMSCHR 1",25,X,"","","","L",23,3)
 G 31:K="-",3:K="," I $L(K) S PN1=K
35 S FP=1935 D:K="-" S4 S (PN2,X)=$P(U2,D,30) D SCROL^READ("OMSCHR 2",45,X,"","","","L",24,3)
 G 33:K="-",3:K="," I $L(K) S PN2=K
37 S FP=2035 D:K="-" S4 S (UA,X)=$P(U2,D,3) D SCROL^READ("AANTAL    ",6,X,"","","""-""[K!(K?.N&(K>0))","",19,35,0)
 G 35:K="-",3:K="," I $L(K) S UA=K
38 I UVM'="MTL" S FP=2035+F60 W @F,"MUNTKODE   : ",UVM G 41
39 S FP=2135 D:K="-" S4 S (UMC,X)=$P(U2,D,22) D SCROL^READ("MUNTKODE  ",3,X,"","","","",20,35,0)
 G 37:K="-",3:K=","
40 I $L(K) G 39:'$D(@("^"_Q_"BA(11,K)")) S UMC=K
41 S FP=1962 D:K="-" S4 S (UEP,X)=$P(U2,D,6),EPR=$P(U2,D,31)
 D SCROL^READ("VERK PRIJS",9,X,"","","","""-,""[K!((K?.N!(K?.N1"".""1N)!(K?.N1"".""2N))&(K'<0))",21,35,0)
42 S:"-,"'[K (UEP,EPR)=K G 3:K="," I K="-" G 39:UVM="MTL" S FP=2135 D S4 G 37
43 S FP=2062 D:K="-" S4 S (USP,X)=$P(U2,D,21) D SCROL^READ("EENH VERK",1,X,"","","""-,EH""[K","",19,62,0)
 G 41:K="-",3:K="," S:$L(K) USP=K S AFE=$P("1\100\1000",D,$F("EHM",USP)-1)
44 S FP=2162 D:K="-" S4 S (PK1,X)=$P($P(U2,D,7),"#",1),PK2=$P($P(U2,D,7),"#",2) D S5
 D SCROL^READ("KORTING 1",4,X,"","","""-,""[K!(K?.N!(K?.N1"".""1N)&(K'>100))","",20,62,0)
45 G 43:K="-",3:K="," S:$L(K) PK1=K S:'PK1 PK2="" D S5 G 49:'PK1
46 S (PK2,X)=$P($P(U2,D,7),"#",2)
47 S FP=2362 D:K="-" S4 S FP=2262 D:K="-" S4,S5
 D SCROL^READ("KORTING 2",4,X,"","","""-,""[K&$L(K)!(K?.N!(K?.N1"".""1N))","",21,62,0)
 G 44:K="-",3:K="," S:$L(K) PK2=K G 46:PK1+PK2>100 D S5
49 S FP=2362 D:K="-" S4 S (ULT,X)=$P(U2,D,25)
 D SCROL^READ("LEVERTERM",2,X,".[] = uit stock","","""-,.""[K!(K?.N&(K>1))","",22,62,0)
 G 3:K="," I $L(K),K'="-" S ULT=K
50 I K="-" G 46:PK1 S FP=2362 D S4 S FP=2262 D S4 G 44
51 S FP=2462 D:K="-" S4 ;S (PNV,X)=$P($P(U2,D,23),"#",2),R="K\23\62\NORM VERP\\6\\""-,""[K!(K?.N)" D S0 G 49:K="-",3:K="," I $L(K) S:'K K="" S PNV=K
53 ;S (PGV,X)=$P($P(U2,D,23),"#",3),R="K\24\62\GROOTVERP\\6\\""-,""[K!(K?.N)" D S0 G 51:K="-",3:K="," I $L(K) S:'K K="" S PGV=K
 S (PNV,PGV)=""
55 S UEP=$J(UEP,0,2),(UN,UBE)=$J(UEP*UA/AFE,0,2) I KKN S UN=$J(UEP*(100-PK1)/100*(100-PK2)/100*UA/AFE,0,2)
57 S U2=$P(U2,D,1,2)_D_UA_D_$P(U2,D,4)_D_UC_D_UEP_D_PK1_"#"_PK2_D_$P(U2,D,8)_D_UN_D_UN_D_$P(U2,D,11,15)_D_UBE_D_$P(U2,D,17,19)_D_PID_D_USP_D_UMC_D_"#"_PNV_"#"_PGV_D_$P(U2,D,24)_D_ULT_D_$P(U2,D,26,28)_D_PN1_D_PN2_D_$P(U2,D,31,99)
59 S @("^"_Q_UGL_"(KC,US,UR,UVN)")=U2
61 S UK="" S:PK1 UK=$J(PK1,4,1) S:PK2 UK=UK_" "_$J(PK2,4,1)
 ;
YZ K EPR,AFA,UA,UEP,UO,PID,SID,SRT,CD,UC,PN1,PN2,USP,PK1,PK2,ULT,PNV,PGV,UK,UVM,UMC,UBE Q
 ;
S5 I 'KKN S UEP=$J(EPR*(100-PK1)/100*(100-PK2)/100,0,2),FP=2148+F60 W @F,@FMTI,$J("",9),@F,UEP,@FMTi
S5Z Q
 ;
S3 S SRT=($E(SID,1)*6)+($E(SID,2)*5)+($E(SID,3)*4)+($E(SID,4)*3)+($E(SID,5)*2)#11 S:SRT=0 SCD=1 S:SRT=1 SCD=0 S:SRT>1 SCD=11-SRT
S3Z Q
 ;
M1 S MSG="DIT IDENTNUMMER BESTAAT REEDS" G MY
MY S FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K Q
 ;
Z X ^cZ Q
ZZ ; 21.06.88 - 11 u 47