BLKALI1 G BEGIN ;Interaktieef verwerken van geconverteerde COA-SO berciht [ 11/04/96  10:58 AM ]
T1 ;@1;0N+;R;7;; | \34;0N+;R;7;; | \2;C;L;8;; || \7;N+;R;7;; | \9;C;L;12;; |\32;C;L;1;;|\31;C;L;21
T2 ;@44;C;L;26;;|\37;N0;R;9;;|\3;N;R;9;;|\40;C;L;5;;|\25;C;L;5;;|\32;C;L;1;;|\31;C;L;14
T3 ;@ToeLev  |   AB    |  KreaDat || Order   | Klant        |C|Type
T4 ;@ KortTekst                |  Aantal |   Oud   | LVW | Oud |C|Type
T5 ;@#06;(\#07;)
 ; 
 ;ChangMd = Changes geeft aan of alleen de veranderingen getoond worden of niet 
 ;A = Alleen wijzigingen
 ;B = Alleen gewijzigigde bons, alle lijnen
 ;empty = Alle bons en alle lijnen
 ;DetMd = Geeft aan of dat het detail getoond wordt of dat de lijst het ganse scherm beslaat
 ;B = Detail van de bon
 ;L = Detail van de KAL
 ;F = Full geen detail
 ;InpMd = Geeft aan of dat de volgende commando op de geselekteerde bon of op de geselekteerde lijn slaat 
 ;B = BON, K = KAL(lijnen)
 ;ScrMd = Geeft aan of de bon informatie getoond wordt of de KAL informatie
 ;B =BON, K = KAL(lijnen)
BEGIN ;
Init Write @F11,@F1
 Write @FMTI," VAN HOECKE : Wijzigen KAL ",@FMTi
 Set BON(1)="^HULP($J,""B"""
 Set BON(2)=$P($T(T1),"@",2)
 Set BON(3)=3,BON(4)=1,BON(5)=80,BON(6)=1,BON(7)=0
 Set BON(8)=$P($T(T3),"@",2)
 Set KAL(1)="^HULP($J,""L"",SToeNr"
 Set KAL(2)=$P($T(T2),"@",2)
 Set KAL(3)=5,KAL(4)=18,KAL(5)=80,KAL(6)=1,KAL(7)=0
 Set KAL(8)=$P($T(T4),"@",2)
 Set (SBon,SLijn)=0,Input="",(InpMd,ScrMd)="K",ChangMd="A",DetMd="F"
 Do ^BLKALS ; Return LevNr en SoDo
 Quit:'LevNr
 ;Goto LBL3:$D(^HULP($J,"B")) ;Tijdelijk
LBL ;Overbrengen en hernummer
 Kill ^HULP($J)
 Do BFill
LBL3 ; Do KAL
LBL4 If ScrMd="K" Set DL(1)="KAL",DL(2)=$P($T(T5),"@",2),DL(3)=$S(SBon'=BON(6)!(ScrMd'=InpMd):-3,1:3) Do SL^PROC
 If ScrMd'="K" Set DL(1)="BON",DL(2)=$P($T(T5),"@",2),DL(3)=3 Do SL^PROC
 Do Help:R="HELP"
 Set Input=R Set:R="ENTER" Input="D"
 Goto YZ:R="-",LBL5:R'=""
 If ScrMd="K" Do KAL ;Na timeout hertekenen
 If DetMd'="F" Do DTL:DetMd="L",BDTL:DetMd="B" ;Na timeout hertekenen
 If ScrMd'=InpMd Set FP=170 W @F,"INPUT : Kal" Set InpMd="K"
 Goto LBL4
LBL5 Goto Bon:InpMd="B"
Lijn Do KAL:'$F("()KB",Input)&(SBon'=BON(6))&(ScrMd="K") ;Consistent houden scherm
 Do Bdown:Input=")",Bup:Input="(",BInp:Input="B",KAL:Input="K"
 Do WIJZ:Input="W",FULL:Input="F",DTL:Input="D",CHANGE:Input="C",Toggle:Input="T"
 Goto LBL4
Bon Do KAL:'$F("()KBF",Input)&(SBon'=BON(6))&(ScrMd="K") ;Consistent houden scherm
 Do Bup:Input="(",Bdown:Input=")",BFull:Input="F",BDTL:Input="D",BKAL:Input="K",BWIJZ:Input="W",BCHANGE:Input="C",BToggle:Input="T"
 If ScrMd'=InpMd Set FP=170 W @F,"INPUT : Kal" Set InpMd="K"
 Goto LBL4
BInp Set FP=170 W @F,"INPUT : Bon" Set InpMd="B" Q
Bup Set DL(1)="BON",DL(2)="UP" Do ML^PROC Q
Bdown Set DL(1)="BON",DL(2)="DO" Do ML^PROC Q
BFull Set ScrMd="B",DetMd="F",SBon=0
 Set DL(1)="BON",DL(2)=3,DL(3)=20 Do PL^PROC Set FP=2301 Write @F,@F1 Q
BKAL Set (ScrMd,InpMd)="K",SBon=0,DL(1)="BON",DL(2)=3,DL(3)=1 Do PL^PROC Do KAL Q
BDTL Q:SBon=BON(6)&(Input="")
 Do BCheck
 If ScrMd="K",DetMd="F" Set DL(1)="KAL",DL(2)=5,DL(3)=13 Do PL^PROC
 If ScrMd="B",DetMd="F" Set DL(1)="BON",DL(2)=3,DL(3)=15 Do PL^PROC
 Set DetMd="B",SLijn=KAL(6)
 Do DBON^BLKALI2
 Q
BMERGE Q  Do BCheck
 Do MERGE^BLKALI2 Q
BWIJZ Do BCheck
 Set DL(1)="BON"
 Do WBON^BLKALI2,EL^PROC:R'="",BDTL:DetMd="B" Q
BCHANGE Set OldMd=ChangMd
 Set:OldMd'="" ChangMd=""
 Set:OldMd="" ChangMd="B"
 Kill:OldMd="A" ^HULP($J,"L")
 Do BFill
 If ScrMd="K" Set SBon=0 Do KAL
 Set FP=130 w @F,$J("",36),@F,"BEPERKING : "_$S(ChangMd="A":"Gewijzigde bon en lijn",ChangMd="B":"Gewijzigde bon",1:"Alles")
 Q
BToggle Do BCheck,BToggle^BLKALI2 
 Set DL(1)="BON" Do EL^PROC
 Q:Status=""
 Kill ^HULP($J,"L",SToeNr)
 Do KAL:ScrMd="K"
 Q
BFill ;Overbrengen en hernummer
 Kill ^HULP($J,"B")
 Set RecCnt=1
 Set ToeNr=199999
BFill1 Set ToeNr=$N(^BLTO(LevNr,SoDo,ToeNr)) Goto BFill2:ToeNr=-1
 Set RecToe=^(ToeNr,1)
 Goto BFill1:ChangMd'=""&($P(RecToe,D,31)="")
 Set $P(RecToe,D,1)=ToeNr,KlantNr=$P(RecToe,D,8)
 If KlantNr,$D(^KK1(KlantNr)) Set $P(RecToe,D,9)=$P(^KKL(^KK1(KlantNr),0),D,2)
 Set ^HULP($J,"B",RecCnt)=RecToe,RecCnt=RecCnt+1
 Goto BFill1
BFill2 Kill DL Set DL(1)="BON",(BON(6),BON(7))=1 Do WL^PROC Q
 ; Verwijderen detail gedeelte, volledig scherm benutten
FULL Set DL(1)="KAL",DL(2)=5,DL(3)=18 Do PL^PROC
 Set FP=2301 Write @F,@F1
 Set DetMd="F"
 Q
KAL Q:SBon=BON(6)&(Input="")
 If DetMd="F" Set KAL(4)=18
 Else  Set KAL(4)=13
 Kill DL
 Set SLijn=0,KAL(6)=1,KAL(7)=1,DL(1)="KAL"
 Do BCheck
 Do Fill:'$D(^HULP($J,"L",SToeNr))
 Do WL^PROC
 ;B
 If DetMd="B" Set SBon=0,Input="" Do BDTL
 If DetMd="L" Set SLijn=0,Input="" Do DTL
 Q
Fill Set SortNr=99,LijnCnt=1
Fill1 Set SortNr=$N(^BLTO(LevNr,SoDo,SToeNr,SortNr)) Goto Fill4:SortNr=-1
 Set RecToe=^(SortNr),Test=$P(RecToe,D,31),Status=$P(RecToe,D,30)
 Goto Fill1:ChangMd="A"&(Test="")
Fill2 Do CLFL
Fill3 Set ^HULP($J,"L",SToeNr,SortKey)=RecToe,LijnCnt=LijnCnt+1
 Goto Fill1
Fill4 Set DL(1)="KAL" DO RL^PROC1 Q
CLFL Set PrdNr=$P(RecToe,D,35) Set:'PrdNr PrdNr=$P(RecToe,D,2)
 If 'PrdNr Set SortKey=$C(126)_":"_LijnCnt,PrdNm="*** "_$P(RecToe,D,36)_" ***" Goto CLFL1
 Set T="",PrdNm=$P(^KPR(PrdNr,0),D,1)_$S($P(^KPR(PrdNr,1),D,20):"",1:"*")
 For I=1:1:$L(PrdNm) Set:$E(PrdNm,I)'?.P T=T_$E(PrdNm,I)
 Set R=^($N(^KPR(PrdNr,"I"))),SortKey=$P(R,D,1)_$E($P(R,D,2),1)_$E($P(R,D,3),1)_" "_T_":"_LijnCnt
CLFL1 Set $P(RecToe,D,44)=PrdNm,$P(RecToe,D,1)=SortNr
 Goto CLFL2:Status="VH"
 Set:'$F(Test,"QTY") $P(RecToe,D,3)=""
 Set:'$F(Test,"LVW") $P(RecToe,D,25)=""
 Q
 ; Alleen bij VH
CLFL2 Set $P(RecToe,D,37)=$P(RecToe,D,3),$P(RecToe,D,3)=""
 Set $P(RecToe,D,40)=$P(RecToe,D,25),$P(RecToe,D,25)=""
 Q
CHANGE Set OldMd=ChangMd
 Set:OldMd'="A" ChangMd="A"
 Set:OldMd="A" ChangMd="B"
 Kill ^HULP($J,"L")
 do BFill:OldMd=""
 Set SBon=0 Do KAL
 Set FP=130 w @F,$J("",36),@F,"BEPERKING : "_$S(ChangMd="A":"Gewijzigde bon en lijn",ChangMd="B":"Gewijzigde bon",1:"Alles")
 Q
Toggle Do LCheck Q:RecToe=""
 Do LToggle^BLKALI2
 Set DL(1)="KAL" Do EL^PROC
 Q
DTL Q:SBon'=BON(6)
 Q:SLijn=KAL(6)&(Input="")
 Do LCheck If RecToe="" Do FULL Q
 If DetMd="F" Set DetMd="L",DL(1)="KAL",DL(2)=5,DL(3)=13 Do PL^PROC
 Do DLIJN^BLKALI2
 Q
EXCH Q
SPLIT ;Do SPLIT^BLKALI2
 Q
WIJZ Do LCheck
 Do WLIJN^BLKALI2 Q:R=""
 Kill DL Set DL(1)="KAL"
 If R'="I" Do CLFL Set ^HULP($J,"L",SToeNr,SLijn)=RecToe Do EL^PROC Goto WIJZ1
 Else  Kill ^HULP($J,"L",SToeNr) Do Fill,WL^PROC
WIJZ1 Do DTL:DetMd="L" Q
LCheck Set SLijn=KAL(6),RecToe=""
 Set:$D(^HULP($J,"L",SToeNr,SLijn)) RecToe=^(SLijn)
 Q
BCheck Set SBon=BON(6),RecToe=^HULP($J,"B",SBon),SToeNr=$P(RecToe,D,1)
 Q
Help Set FP=201 Write @F,@F1
 Kill HLP 
 Set HLP(1)="BLUM WIJZ KAL",HLP(2)="OVERZICHT"
 Set HLP(3)=4,HLP(6)=$P($T(T6),"@",2)
 Do HLP^HELP
 Kill DL
 Set DL(1)="BON" Do WL^PROC,BDTL:DetMd="B"
 If ScrMd="K" Do KAL
 Q
YZ Kill ^HULP($J)
 Q
Z X ^cZ Q
ZZ ; 01.02.91- 10 u 52