HADBGEN ; ;[ 05/27/2002  10:27 AM ]
 Do INIT^vhTERMINA
 Write @F11,@F1
 Do GENPROD()
 Quit
 
GENPROD(GenPRNr) ; Generisch product
 New Input
 Kill HAD
 Set HAD=$$PI^vhPOPUP("C;C","KO2B-","Toepassing","HADB","TOEPAS")
 Quit:HAD'?1A
 Do INIT
 Do REFRESH
 Do FIRST(.HAD)
 For  Do COMMAND Quit:Input="CANC"
 Quit
 
COMMAND Set Input=$$SCROLL^vhLIST(.LD)
 Set BSelKey="",Cnt=0
 For I=1:1:LD("SELECT") Set BSelKey=$O(HAD("B",BSelKey))
 If Input="COM" Set Input="" Do CALL^vhMenu("HADBGEN")
 Set:Input="-" Input="CANC"
 Do EXEC^vhMenu("HADBGEN",.Input)
 Quit
 
INIT New I,Cnt,BRec,BCode,From,To,BStn
 Do INIT^vhLIST("HADB","BOUWSTEEN",.LD)
 Set LD("UPINIT")="X`Set SortKey="""""
 Set LD("UPTRAV")="X`Set SortKey=$O(HAD(""B"",SortKey)) Set sRec=$S(SortKey:HAD(""B"",SortKey),1:"""")"
 Set LD("UPSEL")="@`sCnt=LD(""SELECT"")"
 Set BStn=$P(^RES("HADB","PI","TOEPAS","D",HAD),"`",3)
 Set Cnt=0
 For I=1:1:$L(BStn,"\") Do
 .Set BRec=$P(BStn,"\",I)
 .Set BCode=$P(BRec,";",1)
 .Set From=+$P(BRec,";",3)
 .Set To=+$P(BRec,";",4) Set:'To To=99
 .Set Cnt=Cnt+1
 .Set HAD("BS",BCode)=Cnt_D_From_D_To_D
 Quit
 
FIRST(HAD) 
 New BS,BCode,BStn,From,BouwCnt,I
 Set BStn=$P(^RES("HADB","PI","TOEPAS","D",HAD),"`",3)
 For I=1:1:$L(BStn,"\") Do  ; Opvragen in de juiste volgorde
 .Set BS=$P(BStn,"\",I)
 .Set BCode=$P(BS,";")
 .Set From=+$P(BS,";",2) ; Initieel aantal
 .Quit:'From  ; Optionele bouwsteen
 .For BouwCnt=1:1:From Do
 ..Do INSERT(.HAD,BCode)
 Quit
 
NIEUW New SortKey,Pop,Sort,X,Y,I,Txt
 ; Opzoeken bouwstenen die nog kunnen bijgevoegd worden
 Set BCode=""
 For  Set BCode=$O(HAD("BS",BCode)) Quit:BCode=""  Do
 .Set SortKey=$O(HAD("B",$P(HAD("BS",BCode),D)*100+100),-1)
 .Set BCnt=$S(SortKey\100=$P(HAD("BS",BCode),D):SortKey#100,1:0)
 .If BCnt<$P(HAD("BS",BCode),D,3) Do  ; Opnemen in popup
 ..Set Pop($P(HAD("BS",BCode),D))=BCode
 ;Opbouw popup
 Set Sort="",Y=0
 For  Set Sort=$O(Pop(Sort)) Quit:Sort=""  Do
 .Set BCode=Pop(Sort)
 .Set Txt=$$OMSCHR^HADB("P")
 .Set Y=Y+1,Y(Y)=BCode_"`"_$P(Txt,";",2)
 Set X=$$WILD^vhPOPUP("C;C","KO2-","Bouwsteen",.Y,1)
 Do INSERT(.HAD,X)
 Quit
 
DELETE(BSelKey) 
 New SortKey
 Set BCode=$P(HAD("B",BSelKey),D)
 Set SortKey=$O(HAD("B",$P(HAD("BS",BCode),D)*100+100),-1)
 Set BCnt=$S(SortKey\100=$P(HAD("BS",BCode),D):SortKey#100,1:0)
 If BCnt<$P(HAD("BS",BCode),D,2) W *7 Quit  ; Mag niet verwijderd worden
 Kill HAD("B",BSelKey)
 Do UPDATE^vhLIST(.LD)
 Quit
 
MODIFY(BSelKey) 
 ;Oproep edit scherm
 Set BRec=HAD("B",BSelKey)
 Set BCode=$P(BRec,D)
 X "S BNewRec=$$EDIT^HADB"_BCode_"(.HAD,BRec,BSelKey)"
 Quit:BNewRec=BRec
 Set HAD("B",BSelKey)=BNewRec
 Do UPDATE^vhLIST(.LD)
 Quit
 
INSERT(HAD,BRec) 
 New BCnt,BCode,I,SortKey
 ;Controle of het mag bijgevoegd worden.
 Set BCode=$P(BRec,D)
 Set SortKey=$O(HAD("B",$P(HAD("BS",BCode),D)*100+100),-1)
 Set BCnt=$S(SortKey\100=$P(HAD("BS",BCode),D):SortKey#100,1:0)
 If BCnt'<$P(HAD("BS",BCode),D,3) Quit  ; Max. aantal toegelaten
 ;Oproep edit scherm
 X "S BRec=$$EDIT^HADB"_BCode_"(.HAD,BRec)"
 Quit:'%SC  ; niets ingegeven
 ;Invoegen lijst
 Set SortKey=$P(HAD("BS",BCode),D)*100+BCnt+1
 Set HAD("B",SortKey)=BRec
 ;Update scherm
 Do UPDATE^vhLIST(.LD)
 Quit
 
OMSCHR(Type) 
 Quit $P(^RES("HADB","PI","TOEPAS","D",HAD),"`",2)
 
REFRESH Set FP=1001 Write @F,@F1
 Do HLIJN^vhTERMINA(10,1,80,"","",0)
 Set Titel=" HALUX - "_$P(^RES("HADB","PI","TOEPAS","D",HAD),"`",2)_" "
 Set FP=1000+(80-$L(Titel)/2\1)
 Write @F,Titel
 Do UPDATE^vhLIST(.LD,2)
 Quit