SGREEP2 ;Produkt creatie voor stangengrepen [ 11/22/2003   1:21 PM ]
 Kill
 Do BUILD^A508
 Do INIT^vhTERMINA
 Set Q="K"
 Write @F11,@F1
 Set PRNr=$$GENERATE(,73121)
 Write !,"PRNr = ",PRNr,*7 r r
 Quit
 
GENERATE(Ref,GenPRNr,Params) 
 New sFL,FromPRNr,NewRec,NewPRNr,KLNr,LEVNr,Taal,IsStock,KortT,PR,LT
 Set Ref=$G(Ref),(GenPRNr,PR)=$G(GenPRNr),Params=$G(Params)
 Set:Params="K" KLNr=Ref Set:Params="L" LEVNr=Ref,IsStock=1
 If Params="",GenPRNr Do
 . Set R=$O(^KPR(GenPRNr,"J"))
 . Quit:$E(R)'="J"
 . Set R=^KPR(GenPRNr,R),LEVNr=$P(R,D)
 Set Taal=$G(KT)
 Do BUILD,NEWREC
 Do NIEUW^vhScherm("SGREEP",,,,,,3)
 if %SC Do
 . Do FILLDATA
 . Do SAVE
 Quit $G(NewPRNr)
 
FILLDATA 
 For I=1:1 Quit:'$D(sFL(I))  Set NewRec(I-1)=sFL(I)
 For I="I","J","G" Set NewRec(I)=$G(sFL(I))
 ;DossierNr ingeven
 Set $P(NewRec("G"),D,1)=$$DOSNR()
 ;Korttekst opbouwen (gebruikt bij save)
 Set KortT=$$KORTTXT(NewRec("G"))
 ;Langteksten opbouwen
 Do LANGTXT(NewRec("G"),"N"),LANGTXT(NewRec("G"),"F")
 Do LANGTXT(NewRec("G"),"D"),LANGTXT(NewRec("G"),"E")
 Do BESTELRE(NewRec("G"))
 For Taal="N","F","D","E","R" Do
 . Set:Taal="N" List="0.2,0.11,6.1,6.2,6.3"
 . Set:Taal="F" List="1.22,3.21,8.1,8.2,8.3"
 . Set:Taal="D" List="2.2,3.23,10.1,10.2,10.3"
 . Set:Taal="E" List="2.1,3.22,12.1,12.2,12.3"
 . Set:Taal="R" List="4.1,4.2,4.3,4.4,4.5"
 . ;Huidige implementatie: langtekst 2 regels, Bestelref 3 reg
 . For I=1:1:3 Do
 ..  Set Node=$P($P(List,",",I),".",1)
 ..  Set Piece=$P($P(List,",",I),".",2)
 ..  Set:($D(LT(Taal,I))) $P(NewRec(Node),D,Piece)=LT(Taal,I)
 Set $P(NewRec(1),D,13)=$J($$GEWICHT(NewRec("G")),0,0)
 Set $P(NewRec("J"),D,19)=$$KSTPRIJS(NewRec("G"))
 Quit
BUILD 
 If '$G(FromPRNr) New FromPRNr Set FromPRNr=GenPRNr
 Do FETCHPR^UTILI(FromPRNr,"NewRec")
 Set LEVNr=$P(NewRec("J"),D)
 Set $P(NewRec(0),D,3)=GenPRNr
 Do CLEAN
 Quit
 
CLEAN New Qty
 Set $P(NewRec(0),D,6)="" ; Ligging
 Set $P(NewRec(0),D,12,14)=D_D ; Beginstock,FysStock
 Set $P(NewRec(0),D,16)="" ; Laatste beweging
 Set $P(NewRec(0),D,17)="" ; Bestelling
 Set $P(NewRec(0),D,20)="" ; Schaduwkorttekst
 Set $P(NewRec(0),D,21)="" ; Schaduw sectie
 Set $P(NewRec(1),D,9)="" ; Inventaris fysstock
 Set $P(NewRec(1),D,20)=$G(IsStock) ; Stock/niet stock
 Set $P(NewRec(1),D,21)="" ; Gem Weekverkoop
 Set $P(NewRec(1),D,23)="" ; Gewogen gem. weekverkoop
 Set $P(NewRec(2),D,3)="" ; Schad PPL
 Set $P(NewRec(2),D,4)="" ; Schad Korting
 Set $P(NewRec(2),D,5)="" ; Schad Vork
 Set $P(NewRec(2),D,6)="" ; Schad Winst
 Set $P(NewRec(2),D,7)="" ; Schad Cif
 Set $P(NewRec(2),D,9)="" ; Reservatie
 
 If LEVNr=5005 Set $P(NewRec(2),D,25)=8_$E($P(NewRec(2),D,25),2,99) ;Id
 Else  Set $P(NewRec(2),D,25)=""
 
 If GenPRNr=FromPRNr Do
 . Set $P(NewRec(0),D,2)="" ; Omschrijving N1
 . Set $P(NewRec(0),D,11)="" ; Omschrijving N2
 . Set $P(NewRec(1),D,22)="" ; Omschrijving F1
 . Set $P(NewRec(2),D,25)="" ; Identnummer
 . Set $P(NewRec(3),D,21)="" ; Omschrijving F2
 . Set $P(NewRec("J"),D,3)="" ; Leveranciersref
 . ;Set $P(NewRec("J"),D,24)=50 ; DB% overgeërft van gen. product
 . Set $P(NewRec("J"),D,10)=20 ; KSDB%
 . Set $P(NewRec("J"),D,19)="" ; Aankoopprijs
 . Set $P(NewRec("J"),D,25)="" ; Lijstprijs
 Quit
 
NEWREC 
 For I=0:1 Quit:'$D(NewRec(I))  Set sFL(I+1)=NewRec(I)
 For I="I","J" Set sFL(I)=NewRec(I)
 Quit
 
GEWICHT(Param)  
 New Gewicht,Lengte,Qty,ItemID,SGGewV,SGGewL,VGewL,VoetLengte
 Set Lengte=$P(Param,D,3)
 Set Qty=$P(Param,D,10)
 Set VoetLengte=$P(Param,D,9)
 
 Set ItemID=$P(Param,D,2)
 Set SGGewV=^RES("SGREEP","PI","STANG","G",ItemID,"V")
 Set SGGewL=^RES("SGREEP","PI","STANG","G",ItemID,"L")
 
 Set ItemID=$P(Param,D,8)
 Set VGewL=^RES("SGREEP","PI","VOET","G",ItemID,"L") 
 
 Set Gewicht=SGGewV+(SGGewL*Lengte)+(VGewL*(VoetLengte+5)*Qty)
 Quit $J(Gewicht,0,0)
 
BESTELRE(Param) 
 New Qty,iLoop,Cnt 
 ;Lijn 1 & 2 dienen reeds ingelezen te zijn (Do LANGTXT(Param,"N")) 
 If ((LT("N",1)="")!(LT("N",2)="")) Do 
 . Do LANGTXT(Param,"N")
 
 Set LT("R",1)=LT("N",1)
 Set LT("R",2)=LT("N",2)
 
 ;Lijn 3 opbouwen voor uiteindelijke BestelRef
 Set Cnt=0
 For iLoop=1:1:5 Do
 . If $P(Param,D,10+iLoop)'="" Do
 ..  Set Cnt=Cnt+1
 ..  Set $P(LT("R",3),";",Cnt)="A"_iLoop_"="_$P(Param,D,10+iLoop) 
 Quit
 
KORTTXT(Param) 
 New KortT,ItemID,KTxt,Kleur
 Set KortT=""
 Set ItemID=$P(Param,D,2)
 Set KTxt=$P(^RES("SGREEP","PI","STANG","D",ItemID),"`",4)
 Set Kleur=$P(^RES("SGREEP","PI","STANG","D",ItemID),"`",5)
 
 Set $E(KortT,1)=$E(KTxt,1,7)        ;KortTekst uit resources
 Set $E(KortT,8)=$P(Param,D,1)       ;DossierNr
 Set $E(KortT,12)=$P(Param,D,3)      ;Lengte
 Set $E(KortT,16)="x"_$P(Param,D,10) ;Aantal
 Set $E(KortT,26-$L(Kleur))=Kleur    ;Kleur
 
 Quit KortT
 
LANGTXT(Param,Taal) 
 New ItemID
 ;3 lijnen van langtekst clearen 
 Set LT(Taal,1)="",LT(Taal,2)="",LT(Taal,3)=""
 Set ItemID=$P(Param,D,2)
 Quit:'$D(^RES("SGREEP","PI","STANG","D",ItemID,Taal))
 
 ;Taal gevonden, lijnen L1->L2 invullen
 Set LT(Taal,1)=^RES("SGREEP","PI","STANG","D",ItemID,Taal)
 New TLen,TVoet
 If Taal="N" Set TLen="Lengte" Set TVoet="voetjes"
 Else  If Taal="F" Set TLen="Longueur" Set TVoet="pieds"
 Else  If Taal="E" Set TLen="Length" Set TVoet="feet"
 Else  If Taal="D" Set TLen="L"_$C(228)_"nge" Set TVoet="fuss"
 Else  Set TLen="(Lengte)" Set TVoet="(voetjes)"
 
 Set LT(Taal,2)=TLen_" "_$P(Param,D,3)_"mm, "_$P(Param,D,10)_" "_TVoet
 
 ;Wanneer VoetType & VoetLengte'=Default moet L2 worden uitgebreid 
 New ItemID,VoetType,VoetLengte,Defaults
 Set ItemID=$P(Param,D,2)
 Set VoetType=$P(Param,D,8)
 Set VoetLengte=$P(Param,D,9)
 Set Defaults=$P(^RES("SGREEP","PI","STANG","D",ItemID),"`",7,8)
 If VoetType_"`"_VoetLengte'=Defaults Do
 . Set LT(Taal,2)=LT(Taal,2)_", "_VoetType_" "_VoetLengte_"mm"
 Quit
 
SAVE 
 Set NewPRNr=$$NEXTID^PRODUKT()
 Set IdentNr=$$IDENTNR^PRODUKT(NewPRNr)
 Set $P(NewRec(2),D,25)=IdentNr
 Set $P(NewRec(0),D)=KortT
 ;Write ! ZWrite NewRec r r Quit
 For I=0:1:13 Set ^KPR(NewPRNr,I)=$G(NewRec(I))
 Set:$D(NewRec("G")) ^KPR(NewPRNr,"G")=NewRec("G") ; Generische node
 Set ^KPR(NewPRNr,"I")=""
 Set ^KPR(NewPRNr,"I1")=NewRec("I")
 Set ^KPR(NewPRNr,"J")=""
 Set ^KPR(NewPRNr,"J"_$P(NewRec("J"),D))=NewRec("J")
 ;Indexen
 Do RECALC^PRODUKT2(NewPRNr)
 Do BLDIND^PRODUKT2(NewPRNr)
 Do ZEND^EWPR(NewPRNr)
 Do Gemaakt^PRODUKT2(NewPRNr)
 Quit
 
KSTPRIJS(Param) 
 New KstPrijs,ItemID,SGKstV,SGKstL,Lengte,VKstV,Qty
 Set Lengte=$P(Param,D,3)
 Set Qty=$P(Param,D,10)
 
 Set ItemID=$P(Param,D,2)
 Set SGKstV=^RES("SGREEP","PI","STANG","K",ItemID,"V")
 Set SGKstL=^RES("SGREEP","PI","STANG","K",ItemID,"L")
 
 Set ItemID=$P(Param,D,8)
 Set VKstV=^RES("SGREEP","PI","VOET","K",ItemID,"V") 
 
 Set KstPrijs=SGKstV+(SGKstL*Lengte)+(VKstV*(Qty-2))
 Quit $E($J(KstPrijs,0,2),1,12)
 
DOSNR() 
 New DosNr
 Lock +^KPR(0,"SGNR")
 Set DosNr=$G(^KPR(0,"SGNR"))+1,$P(^KPR(0,"SGNR"),D)=DosNr
 Lock -^KPR(0,"SGNR")
 Quit $$ALFAKEY^vhRtn1(DosNr,"A")
 
VOETDEF(X) ; CB van vhScherm :Afhankelijk van de stang wordt de krijgt de voet een default waarde
 Quit:X=""
 Set Rec=$G(^RES("SGREEP","PI","STANG","D",X))
 Do PUT^vhScherm("VOETTYPE",$P(Rec,"`",7))
 Do PUT^vhScherm("HOOGTE",$P(Rec,"`",8))
 Quit
 
VALIDATE(sFld,Afstand,Qty) ;CB van vhScherm voor validatie van de afstand tussen de voetjes
 New Control,Lengte,Val
 ; Deel 1 : HIDE en SHOW van de afstand velden afh. van het aantalvoeten
 If sFld="QTYVOET" Do 
 . Do REMATTR^vhScherm("A3","","HD"):Qty>2
 . Do REMATTR^vhScherm("A4","","HD"):Qty>3
 . Do PUTATTR^vhScherm("A3","","HD"):Qty<3
 . Do PUTATTR^vhScherm("A4","","HD"):Qty<4
 . Do REPAINT^vhScherm("")
 . Do PUT^vhScherm("A3",""):Qty<3
 . Do PUT^vhScherm("A4",""):Qty<4  
 . Set Afstand=50 ; Standaard afstand 
 . Do PUT^vhScherm(sFld,Qty)
 ; Deel 2 : Vertrekkend van de randafstand worden de tussen afstanden ingevuld
 Set Qty=$$GET^vhScherm("QTYVOET")
 Set Lengte=$$GET^vhScherm("LENGTE")
 If sFld="A1"!(sFld="QTYVOET") Do  ; Defaults invullen
 . Do PUT^vhScherm("A1",Afstand)
 . Do PUT^vhScherm("A5",Afstand)
 . Set Val=+$J($$GET^vhScherm("LENGTE")-$$GET^vhScherm("A1")-$$GET^vhScherm("A5")/(Qty-1),0,1)
 . Do PUT^vhScherm("A2",Val)
 . Do:Qty>2 PUT^vhScherm("A3",Val)
 . Do:Qty>3 PUT^vhScherm("A4",Val)
 ; Deel 3 : Controle door som van de afstanden  
 Set Control=0
 For I=1:1:5 Set Control=Control+$$GET^vhScherm("A"_I)
 If $S(Control<Lengte:Lengte-Control,1:Control-Lengte)<.2 Do
 . Do REMATTR^vhScherm("TOTAAL","","KB")
 Else  Do
 . Do PUTATTR^vhScherm("TOTAAL","","KB")
 Do PUT^vhScherm("TOTAAL",Control)
 Quit
 
LABEL ;Manueel STANGENGREEP
 
 ;---=[IMPORT]=---
IMPORT ;Importeren van ResourceTabel
 ;GlobVars Wissen
 New iLoop
 For iLoop="D","G","K" Do 
 . Kill ^RES("SGREEP","PI","STANG",iLoop)
 . Kill ^RES("SGREEP","PI","VOET",iLoop)
 ;SGREEP Lijst inlezen (TAB delimited)
 Set FileNm=$$READ^vhDEV(,"SGREEP.txt","D`CBIMPSG^SGREEP","B","P")
 ;VOET Lijst inlezen (TABs)
 Set FileNm=$$READ^vhDEV(,"VOET.txt","D`CBIMPV^SGREEP","B","P")
 Quit
 
CBIMPSG(Rec) ;CallBack Import Routine STANGGREEP
 New tmpItemID,D
 Set D="`" 
 Set Rec=$TR(Rec,$C(9),D)
 Write Rec,!
 Set tmpItemID=$P(Rec,D,1)
 Quit:(tmpItemID="")
 Set ^RES("SGREEP","PI","STANG","D",tmpItemID)=$P(Rec,D,2,9)
 
 ;Array Kost
 Set Cnt=9
 For Key="V","L" Do
 . Set Cnt=Cnt+1
 . Set ^RES("SGREEP","PI","STANG","K",tmpItemID,Key)=$TR($P(Rec,D,Cnt),",",".")
 ;Array Gewicht
 Set Cnt=11
 For Key="V","L" Do
 . Set Cnt=Cnt+1
 . Set ^RES("SGREEP","PI","STANG","G",tmpItemID,Key)=$TR($P(Rec,D,Cnt),",",".")
 
 ;Array Taal
 Set Cnt=13
 For Taal="N","F","D","E" Do
 . Set Cnt=Cnt+1
 . If $P(Rec,D,Cnt)'="" Do
 ..  Set ^RES("SGREEP","PI","STANG","D",tmpItemID,Taal)=$P(Rec,D,Cnt)
 
 Quit
 
CBIMPV(Rec) ;CallBack Import Routine VOET
 New tmpItemID,D
 Set D="`" 
 Set Rec=$TR(Rec,$C(9),D)
 Write Rec,!
 Set tmpItemID=$P(Rec,D,1)
 Quit:(tmpItemID="")
 Set tmp=$P(Rec,D,4)
 If $E(tmp)="""" Set $E(tmp)="",$E(tmp,$L(tmp))="",$P(Rec,D,4)=tmp
 Set ^RES("SGREEP","PI","VOET","D",tmpItemID)=$P(Rec,D,2,5)
 
 ;Array Kost
 Set Cnt=5
 For Key="V","L" Do
 . Set Cnt=Cnt+1
 . Set ^RES("SGREEP","PI","VOET","K",tmpItemID,Key)=$TR($P(Rec,D,Cnt),",",".")
 ;Array Gewicht
 Set Cnt=7
 For Key="V","L" Do
 . Set Cnt=Cnt+1
 . Set ^RES("SGREEP","PI","VOET","G",tmpItemID,Key)=$TR($P(Rec,D,Cnt),",",".")
 Quit
 
EXPORT ;Exporteren van Toeleveringen  
 Write @F11,@F1
 New LevNrKey,TLevKey
 New Klant,BestelD,LeverD,RegelNr,OrderRef,KortTekst
 New PrijsSt,TypStang,Len,LenVoet,TypVoet,Qty,Afstand,Line,VQty
 New OrderNr,KlantNr,IProdNr,LnNr,Dev,ExpLine
 
 Set LevNrKey="6502"
 Set TLevKey=""
 
 Lock +^KTO(LevNrKey)
 ;Set Dev=0
 Set Dev=$$OPEN^vhDEV(,"SGreepXport.txt","W")
 Use Dev
 For  Set TLevKey=$O(^KTO(LevNrKey,TLevKey)) Quit:(TLevKey="")  Do
 . Do MAINITEM(LevNrKey,TLevKey)
 Close:0'[Dev Dev
 Lock -^KTO(LevNrKey)
 
 Set Answer=$$^vhTXTPOP("SGREEP","EXPORT")
 
 If Answer="J" Do
 . Do PUTMARKs
 
 Quit
 
MAINITEM(LevNrKey,TLevKey)   ;MainItems:alles @1->@100 
 Set Line=^KTO(LevNrKey,TLevKey,1)
 Set Klant=$P(Line,D,3) 
 Set BestelD=$$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(Line,D,2)),"DK4")
 Set BestelD=$TR(BestelD,"-")
 Set OrderNr=$P(Line,D,7)
 Set KlantNr=$P(Line,D,8)
 Set OrderRef=$P(^KOD(KlantNr,"F",OrderNr,1),D,3)
 If OrderRef?2N1E2N1E2N.E Do  ;Eventuele datum verwijderen
 . Set OrderRef=$E(OrderRef,9,$L(OrderRef)-8)
 Set ExpLine=""
 ;LIJNEN AFHANDELEN
 Set LnNr="100"
 For  Set LnNr=$O(^KTO(LevNrKey,TLevKey,LnNr)) Quit:(LnNr="")  Do 
 . Do SUBITEMS(LevNrKey,TLevKey,LnNr)
 Quit
 
SUBITEMS(LevNrKey,TLevKey,LnNr)  ;SubItems:alles waarbij @3>100 
 Quit:$P(^KTO(LevNrKey,TLevKey,LnNr),D,14)  ;Reeds gemarkeerd? Stop dan 
 Set Line=^KTO(LevNrKey,TLevKey,LnNr)       ;Data inlezen
 Set RegelNr=$P(Line,D,15)
 Set LeverD=$$INTDATE^vhDTyp($P(Line,D,25),"DW")+1
 Set LeverD=$TR($$EXTDATE^vhDTyp(LeverD,"DK4"),"-")
 Set IProdNr=$P(Line,D,2)
 Set KortTekst=$P(^KPR(IProdNr,0),D,1)
 Set Qty=$P(Line,D,3)
 Set PrijsSt=$P(Line,D,6)
 Set TypStang=$P(^KPR(IProdNr,"G"),D,2) 
 Set Len=$P(^KPR(IProdNr,"G"),D,3)
 Set LenVoet=$P(^KPR(IProdNr,"G"),D,9)
 Set TypVoet=$P(^KPR(IProdNr,"G"),D,8)
 Set VQty=$P(^KPR(IProdNr,"G"),D,10)
 
 Do EXPLINEA(Klant,1,10)      ;Data toevoegen aan lijn die 
 Do EXPLINEA(BestelD,11,8)    ;uiteindelijk in bestand komt 
 Do EXPLINEA(LeverD,19,8)    
 Do EXPLINEA(TLevKey,27,6,1,0)
 Do EXPLINEA(RegelNr,33,6)   
 Do EXPLINEA(OrderRef,39,30)
 Do EXPLINEA(KortTekst,69,25) 
 Do EXPLINEA(Qty,94,4,1,0)      
 Do EXPLINEA(PrijsSt,98,7,1,2) 
 Do EXPLINEA(TypStang,105,6)  
 Do EXPLINEA(Len,111,4,1,0)  
 Do EXPLINEA(LenVoet,115,4,1)   
 Do EXPLINEA(TypVoet,119,6)    
 Do EXPLINEA(VQty,125,1,0)    
 For Afst=1:1:5 Do
 .Do EXPLINEA($P(^KPR(IProdNr,"G"),D,10+Afst),120+(Afst*6),6,1,,Afst=5)
 
 Write ExpLine,!   ;Wegschrijven van lijn in bestand
 Quit
 
EXPLINEA(Val,Begin,MaxLen,Numeric,Decimal,EOL)  ;lijn bijwerken ahv para's
 Set Numeric=$G(Numeric,0)
 Set EOL=$G(EOL,0)
 Set Decimal=$G(Decimal,1)  ;DEFAULT: 1 decimaal (bijv. 1,2)
 If Numeric Do   ;-NUMERIEK
 . Set $E(ExpLine,Begin)=$E($J(Val,MaxLen,Decimal),1,MaxLen)
 Else  Do        ;-NIET NUMERIEK
 . If EOL Do        ;-EINDE VAN DE REGEL
 ..  Set $E(ExpLine,Begin)=$E(Val,1,MaxLen)_$J(" ",MaxLen-$L(Val))
 . Else  Do         ;-NIET EINDE VAN REGEL
 ..  Set $E(ExpLine,Begin)=$E(Val,1,MaxLen)
 Quit
 
PUTMARKs ;Markeringen toevoegen aan KTO, ABLijnNummer(piece 14)
 New Regel
 Set Dev=$$OPEN^vhDEV(,"SGreepXport.txt","R")
 Use Dev
 Set Regel=""
 Lock +^KTO(LevNrKey)
 For  Read Regel Quit:(Regel="")  Do 
 . Set TLevKey=$TR($E(Regel,27,32)," ")
 . Set RegelNr=$TR($E(Regel,33,38)," ")
 . Set LnNr=^TO("IU",TLevKey,RegelNr)
 . Set $P(^KTO(LevNrKey,TLevKey,LnNr),D,14)=1
 Lock -^KTO(LevNrKey)
 Close:0'[Dev Dev
 Quit