HADSTOCK  ;[ 01/17/2002  4:41 PM ]
 
MAIN ;Hoofd routine
 Do PRIO^vhINITML("L")
 Do INIT 
 Do SELECT
 Do REFRESH 
 Do FETCH(VanMaand,TotMaand)
 Do DISPLST(10) 
 Do NAVIGATE 
 Do PRIO^vhINITML()
 Quit 
 
INIT ;Intialisatie variabelen 
 Do INIT^vhTERMINA    
 Do INIT^vhLIST("HADSTOCK","OVZTEMP",.LD)
 Set (VanMaand,TotMaand,RefDtm)=""
 Set Maanden=13
 Set Datum=$h
 Set ZaagMm=10
 Set AfvalPct=1.1
 Set T="9999.99"
 Kill Data,List,Fill
 Set i=10
 Quit
 
NAVIGATE 
 ;Navigatie door scrolllijst
 For  Do  Quit:Input="-"!(Input="CANC")
 . Set Input=$$SCROLL^vhLIST(.LD)
 . Quit:Input="CANC"!(Input="-")
 . If Input="COM"  Set Input="" Do CALL^vhMenu("HADSTOCK")
 . If (Input="(")  Do
 .. Set i=i-1
 .. If (i=-1)  Do
 ... Set i=0
 ... Write *7
 . If (Input=")")  Do
 .. Set i=i+1 
 .. If (i=(Maanden-2))  Do
 ... Set i=Maanden-3
 ... Write *7
 . If Input="" Quit
 . Do DISPLST(i) 
 . Do EXEC^vhMenu("HADSTOCK",.Input)
 Quit
 
REFRESH 
 ;Herteken scherm
 Write @F11,@F1
 Do DISPLAY^vhScherm("HADSTOCK")
 Quit
 
SELECT ;Selectie VanMaand en TotMaand  
 Set VanMaand=$$CALCDATE^vhLib.DataTypes(Datum,"M",-Maanden)
 Set TotMaand=$$CALCDATE^vhLib.DataTypes(Datum,"M",0)
 Set RefDtm=VanMaand
 Quit 
 
FETCH(VanMaand,TotMaand) 
 ;Bereken de gegevens voor de opgegeven periode
 New PRNr,PRCnt,GenPRNr,Params,Histo,BDtm,EDtm
 Set (PRNr,PRCnt,GenPRNr)=0
 Set BDtm=$$CALCDATE^vhLib.DataTypes(VanMaand,"M","FD")
 Set EDtm=$$CALCDATE^vhLib.DataTypes(TotMaand,"M","LD")
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do  ;Quit:PRCnt>10500
 . Kill Histo
 . If (PRCnt#100=0)  Do 
 .. Do Disp("Produkten : "_PRCnt,5,22) 
 . Set PRCnt=PRCnt+1
 . Set Params=$$GETPROD(PRNr)
 . Quit:Params=""
 . Do CLCHISTO(PRNr,BDtm,EDtm,.Histo)
 . Do HISTO(Params,.Histo) 
 . Do TOELVRNG(PRNr,Params) 
 Quit 
 
 ; Oude versie uit ^KPR(PRNr,"Hxxx")
FETCHOld(VanMaand,TotMaand) 
 ;Bereken de gegevens voor de opgegeven periode
 New PRNr,PRCnt,GenPRNr,Params,Histo,BDtm,EDtm
 Set (PRNr,PRCnt,GenPRNr)=0
 Set BDtm=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(VanMaand,"M","FD"),"DSN2") 
 Set EDtm=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(TotMaand,"M","LD"),"DSN2") 
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do  ;Quit:PRCnt>10500
 . Kill Histo
 . If (PRCnt#100=0)  Do 
 .. Do Disp("Produkten : "_PRCnt,5,22) 
 . Set PRCnt=PRCnt+1
 . Set Params=$$GETPROD(PRNr)
 . Quit:Params=""
 . Do CLCHISTO(PRNr,BDtm,EDtm,.Histo)
 . Do HISTO(Params,.Histo) 
 . Do TOELVRNG(PRNr,Params) 
 Quit 
 
CLCHISTO(PRNr,Begin,Einde,Histo) 
 New HistNr,HistRec,Exit,Soort,Cumul,Dtm
 Set (HistNr,Exit)="",Soort="I"
 Set Einde=$S($G(Einde)="":+$H,1:Einde)
 For  Set HistNr=$O(^PRHIST(PRNr,HistNr),-1) Quit:HistNr=""  Do  Quit:Exit
 . Set HistRec=^PRHIST(PRNr,HistNr)
 . Quit:$P(HistRec,D,4)'=Soort
 . Quit:$P(HistRec,D)>Einde
 . Set Exit=($P(HistRec,D)<Begin)
 . Quit:Exit
 . Set Dtm=$$EXTDATE^vhLib.DataTypes($P(HistRec,D),"DM4")_" "
 . Set Cumul=$G(Histo(Dtm))
 . Set $P(Cumul,D,1)=$P(Cumul,D,1)+$P(HistRec,D,2)
 . Set $P(Cumul,D,2)=$P(Cumul,D,2)+$P(HistRec,D,12)
 . Set Histo(Dtm)=Cumul
 Quit 
 
 ; Oude versie uit ^KPR(PRNr,"Hxxx")
CLCHISTOOld(PRNr,Begin,Einde,Histo) 
 ;Begin,Einde : Formaat 'JJMMDD'
 New Key,Cumul,Soort,Dtm
 Set Soort=1
 Set Key="H"
 set Cumul=""
 ;Set formaat naar 'JJJJMMDD'
 Set Begin=$S($G(Begin)="":0,1:$S($E(Begin,1,2)>50:19,1:20)_Begin)
 Set Einde=$S($G(Einde)="":99999999,1:$S($E(Einde,1,2)>50:19,1:20)_Einde) 
 For  Set Key=$O(^KPR(PRNr,Key)) Quit:$E(Key)'="H"  Do
 . Set Rec=^KPR(PRNr,Key)
 . For  Set Node=$P(Rec,D),Rec=$P(Rec,D,2,999)  Do:Node'=""  Quit:Rec=""
 .. If Soort Quit:$E(Node,7)'=Soort
 .. Quit:$S($E(Node,1,2)>50:19,1:20)_$E(Node,1,6)<Begin
 .. Quit:$S($E(Node,1,2)>50:19,1:20)_$E(Node,1,6)>Einde
 .. Set Dtm=$S($E(Node,1,2)>50:19,1:20)_$E(Node,1,2)_"."_$E(Node,3,4)_" "
 .. Set Cumul=$G(Histo(Dtm)) 
 .. Set $P(Cumul,D,1)=$P(Cumul,D,1)+$E($P(Node,"#"),8,99)
 .. Set $P(Cumul,D,2)=$P(Cumul,D,2)+$P(Node,"#",2)
 .. Set Histo(Dtm)=Cumul
 Quit 
 
HISTO(Params,Histo) 
 ;Bereken de historiek voor de opgegeven periode en gegeven PRNr
 ;en dit per maand
 New Maand,BDtm,EDtm,Qty
 Set Maand="" 
 For  Set Maand=$O(Histo(Maand)) Quit:Maand=""  Do
 . Set $P(Params,D,6)=Histo(Maand) 
 . Do WRITEREC(Maand,Params)
 Quit 
 
TOELVRNG(PRNr,Params) 
 ;Bereken wat in de toeleveringen zit
 New TOLNr,TLUNr,TLLNr,Qty,LEVNr
 Set TOLNr=0
 For  Set TOLNr=$O(^TO("IP",PRNr,TOLNr)) Quit:TOLNr=""  Do
 . Set TLUNr=0
 . For  Set TLUNr=$O(^TO("IP",PRNr,TOLNr,TLUNr)) Quit:TLUNr=""  Do
 .. Set TLLNr=^TO("IP",PRNr,TOLNr,TLUNr)
 .. Set LEVNr=$P(^KTO1(TOLNr),D,1) 
 .. Set $P(Params,D,6)=$P(^KTO(LEVNr,TOLNr,TLLNr),D,3)
 .. Quit:'$P(Params,D,6)
 .. Do WRITEREC(T_" ",Params) 
 Quit
 
GETPROD(PRNr) 
 New Profiel,Hoogte,Breedte,tmp,Params
 ;Data kan uit het bestand gehaald worden
 New GenPRNr,Params,Produkt,Hoogte,Breedte
 Set GenPRNr=$P(^KPR(PRNr,0),D,3)
 Set Params=""
 If (GenPRNr=57791)!(GenPRNr=51240)!(GenPRNr=61677) Do  ; Kaderdeur GEN.HADKAD
 . ;Write PRNr," "
 . Quit:'$D(^KPR(PRNr,"G")) 
 . Set Produkt=$P(^KPR(PRNr,"G"),D,2) 
 . Set Hoogte=$P(^KPR(PRNr,"G"),D,8) 
 . Set Breedte=$P(^KPR(PRNr,"G"),D,9) 
 . Quit:$L(Produkt)<2
 . Set Fill(Produkt,"P")=""
 . Set Params="P\K"_D_Produkt_D_Hoogte_D_Breedte
 . ;Write GenPRNr,":",Params,!
 Else  If GenPRNr=64421 Do              ; Losse profiel GEN.HADPR
 . ;Data moet uit de korttekst gehaald worden -> PARSE
 . Set Params=$$PARSE(PRNr) 
 Else  If (PRNr=50042)!(PRNr=50043)  Do  ; Produkt is een hoekstuk
 . Set:PRNr=50042 Produkt="HAL.HKGR"
 . Set:PRNr=50043 Produkt="HAL.HKKL"
 . Set Params="D\H"_D_Produkt
 . Set Fill(Produkt,"D")=""
 Quit Params
 
WRITEREC(Mnd,Params) 
 ;Gen. Produkt is een los profiel of kaderdeur
 New Rec,Key,Produkt,Data1,Data2,Qty,Soort
 Set (Rec,Key,Produkt,Data1,Data2,Qty,Soort)=""
 Set Key=$P(Params,D,1)           ;"P" voor profiel
 Set Soort=$P(Params,D,2)         ;"K" Kaderdeur, "L" Los profiel
 Set Produkt=$P(Params,D,3)       ;Produkt beschrijving
 Set Data1=$P(Params,D,4)         ;Hoogte kaderdeur, Lengte profiel
 Set Qty=$P(Params,D,6)           ;Hoeveelheid
 If (Key="P")&(Soort="K")  Do
 . Set Data2=$P(Params,D,5)       ;Breedte kaderdeur
 . Set Rec=$G(Data(Produkt,Key,Mnd))
 . ;Bereken het aantal, verbruik en verbruik met uitval
 . Set $P(Rec,D,1)=$P(Rec,D,1)+(((Data1+Data2)*2)*Qty)
 . Set $P(Rec,D,2)=$P(Rec,D,2)+((((Data1+Data2+ZaagMm)*2)*AfvalPct)*Qty)
 . Set $P(Rec,D,3)=$P(Rec,D,3)+Qty 
 . Set Data(Produkt,Key,Mnd)=Rec
 . ;Tel aantal hoekstukken
 . Do HAL(Mnd,Qty,Produkt) 
 . ;Tel het aantal schroeven gebruikt
 . Do SCHROEF(Mnd,Qty)
 . ;Bereken lengte afdichting HAL.UPRO
 . Do HALUPRO(Mnd,Qty,Produkt,Data1,Data2)
 . Quit
 If (Key="P")&(Soort="L")  Do
 . Set Rec=$G(Data(Produkt,Key,Mnd))
 . ;Bereken het aantal, verbruik en verbruik met uitval
 . Set $P(Rec,D,1)=$P(Rec,D,1)+(Data1*Qty)
 . Set $P(Rec,D,2)=$P(Rec,D,2)+(((Data1+ZaagMm)*AfvalPct)*Qty)
 . Set $P(Rec,D,3)=$P(Rec,D,3)+Qty 
 . Set Data(Produkt,Key,Mnd)=Rec
 . Quit
 If ((Key="D")&((Soort="H")!(Soort="S")))  Do  ;Begin diversen
 . Set Rec=$G(Data(Produkt,Key,Mnd))
 . Set $P(Rec,D,3)=$P(Rec,D,3)+Qty 
 . Set Data(Produkt,Key,Mnd)=Rec
 . Quit
 If (Key="D")&(Soort="U")  Do        ;Afdichting
 . Set Data2=$P(Params,D,5)           
 . Set Rec=$G(Data(Produkt,Key,Mnd))
 . Set $P(Rec,D,1)=$P(Rec,D,1)+Data1   ;Lengte zonder afval
 . Set $P(Rec,D,2)=$P(Rec,D,2)+Data2   ;Lengte met afval
 . Set $P(Rec,D,3)=$P(Rec,D,3)+Qty     ;Hoeveelheid 
 . Set Data(Produkt,Key,Mnd)=Rec
 Quit 
 
HAL(Mnd,Qty,Produkt) 
 ;Tel het aantal hoekstukken gebruikt
 New Params,Soort,Hal,Soort2
 Set Hal=""
 Set Soort=$E(Produkt,2)
 Set Soort2=$E(Produkt,5,6) 
 ;Kijk welk soort hoekstuk
 Set:Soort="B" Hal="HAL.HKGR"
 Set:Soort="S" Hal=$S(Soort2="WE":"HAL.HKWE",1:"HAL.HKKL")
 Quit:Hal=""  ;Indien het geen enkele van de 3 soorten is: Quit
 Set Params="D\H"_D_Hal 
 Set $P(Params,D,6)=4*Qty 
 Do WRITEREC(Mnd,Params) 
 Quit
 
HALUPRO(Mnd,Qty,Produkt,Data1,Data2) 
 ;Bereken lengte afdichting rekening houdend met aftrek voor glas 
 New Params,Aftrek
 Set Params="D\U\HAL.UPRO"
 Set Aftrek=$P($G(^RES("HAD","PI","PROFIEL","D",Produkt)),"`",3)
 Set $P(Params,D,4)=(((Data1+Data2-(4*Aftrek))*2)*Qty)
 Set $P(Params,D,5)=((((Data1+Data2+ZaagMm-(4*Aftrek))*2)*AfvalPct)*Qty)
 Set $P(Params,D,6)=Qty
 Set Fill("HAL.UPRO","D")=""
 Do WRITEREC(Mnd,Params)
 Quit 
 
SCHROEF(Mnd,Qty) 
 ;Tel schroeven 
 New Params 
 Set Params="D\S\Schroeven" 
 Set $P(Params,D,6)=Qty*4*2
 Set Fill("Schroeven","D")=""
 Do WRITEREC(Mnd,Params)
 Quit 
 
PARSE(PRNr) 
 ;Parse de korttekst en kijk of er een geldig profiel 
 ;in zit
 New Kort,Produkt,Lengte
 Set Kort=$P(^KPR(PRNr,0),D,1) 
 Set Produkt=$E(Kort,1,6)
 ;Check of dat het profiel bestaat, anders quit leeg 
 If ('$G(^RES("HAD","PI","PROFIEL","D",Produkt))) Quit ""
 Set Lengte=+$E(Kort,8,99)
 Set:Lengte<10 Lengte=Lengte*1000
 Set Fill(Produkt,"P")=""
 Quit "P\L"_D_Produkt_D_Lengte 
 
Disp(str,x,y) 
 Set FP=y*100+x
 Write @F,@FDL,str
 Quit
 
WRITELST(offset) 
 ;Converteer Data naar een flatlist en dit aan de hand van de
 ;doorgegeven offset
 ;Data(Produkt,Key,Mnd) -> List(Produkt)
 New Key,Produkt,Rec,Piece,Mnd1,Mnd2,Mnd3,Mnd4
 Set (Rec,Index)=0
 Kill List
 Set Produkt=""
 ;Gebruik Fill om ALLE produkten af te gaan ook die nul zijn
 ;op deze manier veranderd de hoogte niet bij het scrollen
 Set Mnd1=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(RefDtm,"M",offset),"DM4")_" "
 Set Mnd2=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(RefDtm,"M",offset+1),"DM4")_" "
 Set Mnd3=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(RefDtm,"M",offset+2),"DM4")_" "
 Set Mnd4=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(RefDtm,"M",offset+3),"DM4")_" "
 For  Set Produkt=$O(Fill(Produkt)) Quit:Produkt=""  Do 
 . Set Key=""
 . For  Set Key=$O(Fill(Produkt,Key)) Quit:Key=""  Do 
 .. ;Maak een index aan die de profiel produkten eerst plaatst
 .. Set Index="0"_Produkt
 .. Set:Key'="P" Index="1"_Index
 .. Set Rec=$G(List(Index))
 .. Set $P(Rec,D,1)=Key
 .. Set $P(Rec,D,2)=Produkt
 .. ;Selecteer de juiste piece:2 voor de profielen,dichting de rest 3 
 .. Set Piece=2
 .. If (Produkt["HAL.HK")!(Produkt["Schroeven") Set Piece=3
 .. Set Div=$S(Piece=3:1,1:1000) ; lengtes in meters ipv mm
 .. ;Bereken de 4 datums aan de hand van de gegeven offset
 .. Set $P(Rec,D,3)=$P($G(Data(Produkt,Key,Mnd1)," \ \ "),D,Piece)/Div
 .. Set $P(Rec,D,4)=$P($G(Data(Produkt,Key,Mnd2)," \ \ "),D,Piece)/Div
 .. Set $P(Rec,D,5)=$P($G(Data(Produkt,Key,Mnd3)," \ \ "),D,Piece)/Div
 .. Set $P(Rec,D,6)=$P($G(Data(Produkt,Key,Mnd4)," \ \ "),D,Piece)/Div
 .. Set $P(Rec,D,7)=$P($G(Data(Produkt,Key,"9999.99 ")," \ \ "),D,Piece)/Div
 .. Set List(Index)=Rec
 Do RENUMBER^vhLIST(.LD) 
 Quit
 
DISPLST(offset) 
 New title,Dtm
 ;Toon de lijst op het scherm
 ;check ofdat de gegeven offset op de RefMnd ok is en geef de title
 Set title=$$CHECKDTM(offset)
 Quit:title=""
 Do SETTITLE(" Type | Produkt  | "_title_" | Toelevering ")         
 Do WRITELST(offset)
 Do WRITE^vhLIST(.LD) 
 Quit 
 
SETTITLE(title) 
 ;set de title van de lijst
 Set $P(^RES("HADSTOCK","LD","OVZTEMP","HO","1"),"`",3)=title 
 Quit 
 
CHECKDTM(offset) 
 ;Check ofdat het binnen de gebruikte datum zit 
 New Mnd1,Mnd2,Mnd3,Mnd4,Dtm
 Quit:(offset<1)&(offset>(Maanden-3)) ""
 ;Maak de title aan:
 Set Mnd1=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(RefDtm,"M",offset),"DM4")_" "
 Set Mnd2=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(RefDtm,"M",offset+1),"DM4")_" "
 Set Mnd3=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(RefDtm,"M",offset+2),"DM4")_" "
 Set Mnd4=$$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(RefDtm,"M",offset+3),"DM4")_" "
 Quit Mnd1_" | "_Mnd2_" | "_Mnd3_" | "_Mnd4
 
WRITEFLE 
 ;Schrijf data naar bestand
 New Produkt,Mnd,Key
 Set Dev=0
 ; Vraag een FileName
 Do STORE^vhTERMINA()
 Set Dev=$$OPEN^vhDEV(,"KADERDEUR.TXT","W","A")
 Do REFRESH^vhTERMINA()
 Quit:'Dev
 Use:Dev Dev
 Write "Produkt",$C(9),"Type",$C(9),"Datum",$C(9),"Lengte zonder uitval",$C(9),"Lengte met uitval",$C(9),"Aantal",!
 Set Produkt=""         
 For  Set Produkt=$O(Fill(Produkt)) Quit:Produkt=""  Do 
 . Set Key=""
 . For  Set Key=$O(Fill(Produkt,Key)) Quit:Key=""  Do 
 .. Set Mnd=""
 .. For  Set Mnd=$O(Data(Produkt,Key,Mnd)) Quit:Mnd=""  Do 
 ... Set Rec=$G(Data(Produkt,Key,Mnd)," \ \ ")
 ... Write Produkt,$C(9),Key,$C(9),$TR(Mnd,".","-"),$C(9),$TR($P(Rec,D,1),".",","),$C(9),$TR($P(Rec,D,2),".",","),$C(9),$P(Rec,D,3),!
 Close:Dev'=0 Dev
 Quit