#include vhLib.Macro
 
HADWIZ ;Halux deuren wizard [ 11/28/2003  9:45 AM ]
 Do INIT^vhTERMINA
 ;Do DISPLAY(59067)
 ;Do CREATE()
 w $$CREATE^HADWIZ(3711,1) 
 ;Do PRINT("ORD",175907)
 Quit
CREATE(KLNr,PRNr,Aantal,Munt,ObjTyp,Data) 
 ;ObjTyp: OFF;ORD;TOE
 New X,Y,Form,Qty,HalID
 Set:'$G(KLNr) KLNr=3479
 Set:'$L($G(Munt)) Munt="EUR"
 Set:'$L($G(ObjTyp)) ObjTyp="ORD"
 Set:'$G(Aantal) Aantal=1
 Set HalID=$S($G(PRNr):$P($G(^KPR(PRNr,"G")),D,13),1:"")
 Do STORE^vhTERMINA()
 Set FP=2001 Write @F,@F1
 Set Y=0
 Set X=""
 ; Code`Omschrijving`Groep`Actie`Form`ViaIPCom
 Set:KLNr=3479 Y=Y+1,Y(Y)="S`Svedex`KAD`CREATE`SVDX",X="S"
 Set:KLNr=2523 Y=Y+1,Y(Y)="K`Keukengroep`KAD`CREATE`TULP",X="T"
 Set Y=Y+1,Y(Y)="W`Kaderdeur wizard`KAD`CREATE`Wiz"
 Set Y=Y+1,Y(Y)="B`Banco`BAN`CREATE`BAN"
 Set Y=Y+1,Y(Y)="T`Tandembox in sequentie`TBX`CREATE``1"
 Set Y=Y+1,Y(Y)="U`Tandembox`TBX`CREATE``1"
 Set Y=Y+1,Y(Y)="E`TL-verlichting op maat`TLM`CREATE``1"
 Set Y=Y+1,Y(Y)="G`Greep op maat`GRP`CREATE``1"
 Set Y=Y+1,Y(Y)="M`Mat op maat`ASM`CREATE``1"
 Set Y=Y+1,Y(Y)="&S"
 If $L(HalID) Do
 . Set Y=Y+1,Y(Y)="C`Convert/Dupliceer``CONV`CONV"
 Set Y=Y+1,Y(Y)="D`Dupliceer van ...``CONV`CONV"
 Set X=$$WILD^vhPOPUP("C;C","AB1OK-","Ingave formulier",.Y,X) 
 If zb="CANC" Quit ""
 If X="D" Do  Quit:HalID="" ""  ;Dupliceer
 .Set PRNr=$$SELECT^PRODUKT6()
 .Set HalID=""
 .Quit:PRNr'?4.7N
 .Set HalID=$P($G(^KPR(PRNr,"G")),D,13)
 For Y=1:1:$O(Y(""),-1)  Quit:$P(Y(Y),"`")=X
 Set Groep=$P(Y(Y),"`",3)
 Set Actie=$P(Y(Y),"`",4)
 Set Form=$P(Y(Y),"`",5)
 Set ViaIPCom=$P(Y(Y),"`",6)
 If Groep="",HalID,$P(^KPR(PRNr,"G"),D,2)="TBX" Do
 .. Set Groep="TBX"
 .. Set ViaIPCom=1
 Set:Groep="TBX" HalID=""
 Set FP=2001 Write @F,@F1
 Set FP=2104 Write @F,"  HALID :"
 Set FP=2115 Write @F,HalID
 Set FP=2144 Write @F,"   Form :"
 Set FP=2155 Write @F,Form
 Set FP=2204 Write @F,"   Munt :"
 Set FP=2215 Write @F,Munt
 Set FP=2244 Write @F," ObjTyp :"
 Set FP=2255 Write @F,ObjTyp
 Set FP=2304 Write @F," Aantal :"
 Set FP=2315 Write @F,Aantal
 Set FP=2344 Write @F,"  Klant :"
 Set FP=2355 Write @F,$G(KLNr)
 Set FP=2404 Write @F,"Product :"
 Set FP=2007 Write @F,"HALUX\"_$S(ViaIPCom:"MAPP",1:"WIZARD")_"\CREATE"
 ; Invullen IPCom 
 Set Key=$$NewIPCom(Groep,Actie)
 If Key="" Do  Quit ""
 .Do WARN^vhTXTPOP("Kan wizard niet starten, verwittig ICT")
 ;Invullen extra paramters voor IPCom
 Set ^IPCom("D",Key,"P","HALID")=HalID
 Set ^IPCom("D",Key,"P","GENTYPE")=$S($L($G(PRNr)):$P($$GENTYP^HAD(PRNr),"\",1,2),1:"")
 Set ^IPCom("D",Key,"P","FORM")=Form
 Set ^IPCom("D",Key,"P","MUNT")=Munt
 Set ^IPCom("D",Key,"P","OBJTYP")=ObjTyp
 Set ^IPCom("D",Key,"P","AANTAL")=Aantal
 Set ^IPCom("D",Key,"P","KLANT")=$G(KLNr)
 Set ^IPCom("D",Key,"P","QU")=$G(QU)
 If (X="T"),$G(PRNr)?4.7N,$D(^HADPR("P",PRNr,"BP")) Set ^IPCom("D",Key,"P","DFLREF")=$NA(^HADPR("P",PRNr,"BP")),^IPCom("D",Key,"P","DFLPR")=PRNr
 ; Start Applicatie
 Set FP=2001 Write @F,"VBA:\\"
 
 New IsCancelled,CanQuitECPWaitingLoop
 Set IsCancelled=0
 
 ; Terugkeer van VBA
 If ViaIPCom Do
 . Set FP=2320 Write @F Read Qty ; Wachten op terugkeer
 . Set CanQuitECPWaitingLoop = 0
 . For i = 1 : 1 : 100 Do  Quit:(CanQuitECPWaitingLoop)  Hang 0.1   ; met interval van 0.1 sec checken of ^IPCom() ingevuld is (global mapping via ECP).  --> max 100 iteraties = 10 sec wachten 
 . . Set IsCancelled=($G(^IPCom("D",Key,"P","DialogResult"))="CANCELLED")
 . . Set PRNr=$G(^IPCom("D",Key,"P","PRNR")) 
 . . Set CanQuitECPWaitingLoop=(IsCancelled)||($length(PRNr))
 . Set Qty=$G(^IPCom("D",Key,"P","AANTAL"))
 .   ;d WLIP^vhDBG(97,$$$ArrayTT($Na(^IPCom("D",Key))))
 Else  Do
 . Set FP=2320 Write @F Read Qty
 . Set FP=2415 Write @F Read PRNr
 Kill ^IPCom("D",Key)
 Quit:(IsCancelled)||(PRNr="") ""
 
 If PRNr'?4.7N||'$D(^KPR(PRNr)) Do WARN^vhTXTPOP("Foutief produktID, verwittig ICT") Quit ""
 Do AdaptPlanilak
 Do RECALC^PRODUKT2(PRNr)
 Do BLDIND^PRODUKT2(PRNr)
 ;If $G(KLNr),$$CHECK^KLHFUTZ(KLNr,$S($P($$GENTYP^HAD(PRNr),D,1)="TBX":"BX",1:"XXXXX")) Do CALC^KLHFUTZ(KLNr,PRNr)
 If $G(^KLPUTZ("AS")) Do kpcCalcSchaduwPrijs(PRNr)
 Do ZEND^EWPR(PRNr)
 
 Do REFRESH^vhTERMINA()
 Set Data(1)=PRNr_D_Qty
 Quit
 
 
kpcCalcSchaduwPrijs(PRNr)
	Quit:'$D(^PRBS("BS",PRNr))
	Do CTRONE^PRBSC(PRNr,"S","S",1)
	Quit
 
AdaptPlanilak
	Quit
	;Deze routine moet uitgevoerd worden voor de RECALC !!
 	Set RecG=$G(^KPR(PRNr,"G"))
 	;Quit:$P($P(RecG,D,2),"-")'="PBK" ; geen test op profieltype
 	Set Vulling=$P(RecG,D,10)
 	Quit:Vulling="" ; zonder vulling
 	Set IsPlanilak=$P($G(^RES("HAD","PI","VULLING","D",Vulling)),"`",6)
 	Quit:'IsPlanilak ; De flag Planilak moet opstaan voor het glas
 	Set RecJ=^KPR(PRNr,$O(^KPR(PRNr,"J")))
	Set PPL=$P(RecJ,D,19)
	Set PPL=+$J(PPL*$S($G(KLNr)=3479:0.9,1:0.95),0,2) ; Korting van 10% voor SVEDEX en voor de andere klanten 5% op de ganse kostprijs
	Set $P(RecJ,D,19)=PPL
	Set ^KPR(PRNr,$O(^KPR(PRNr,"J")))=RecJ
	Do WARN^vhTXTPOP($S($G(KLNr)=3479:10,1:5)_"% extra")
	Quit	
 
 
GetIP()
	New IONaam,CNaam,IP
 	Set IONaam=$I
    Quit:$E(IONaam,1,5)'="|TNT|"
    Set CNaam=$P($E(IONaam,6,99),":",1)
    If CNaam?1.3N1"."1.3N1"."1.3N1"."1.3N Do  ; eerst kijken of het IPAdres niet vervat zit in de device $I
  	. Set IP=CNaam
  	Else  Do  ; opzoeken van het IPAdress in de cQSYS tabel
    . ;Set IP=$P($G(cQSYS(0,"DDB",io)),",",2)
    . Set IP=""         ; niet opzoeken in cQSYS, altijd via GetIP() 
    . If IP'?1.3N1"."1.3N1"."1.3N1"."1.3N Set IP=$$GetIP^BLDSYSLOG(CNaam,1) ; vertaling aanvragen van de Computernaam naar IPAdres
  	Quit IP
NewIPCom(Groep,Actie) 
 New Key
 Lock +^IPCom("N")
 Set Key=$G(^IPCom("N"))+1
 Set ^IPCom("N")=Key
 Lock -^IPCom("N")
 Kill ^IPCom("D",Key)
 Set IP=$$GetIP()
 Set:(IP="127.0.0.1") IP=$$GetIP^BLDSYSLOG($$$Server,1)   ; Patch voor lokale terminal op CacheServer  ; Added by WimV on 18/05/2011 
 Quit:IP'?1.3N1"."1.3N1"."1.3N1"."1.3N ""
 Set ^IPCom("IP",IP)=Key
 Kill ^IPCom("D",Key)
 Set ^IPCom("D",Key)=Groep_"`"_Actie_"`"_$H_"`"_IP
 Quit Key
NewIPCom2(Groep,Actie) 
 New Key,IP
 Do WLIP^vhDBG(97,"Test IP")
 Set IP=$$GetClientIP^vhLib()
 Quit:IP'?1.3N1"."1.3N1"."1.3N1"."1.3N ""
 Lock +^IPCom("N")
 Set Key=$G(^IPCom("N"))+1
 Set ^IPCom("N")=Key
 Lock -^IPCom("N")
 Kill ^IPCom("D",Key)
 Set ^IPCom("IP",IP)=Key
 Kill ^IPCom("D",Key)
 Set ^IPCom("D",Key)=Groep_"`"_Actie_"`"_$H_"`"_IP
 Quit Key
 
 
DISPLAY(PRNr,Aantal,Munt) 
 New HalID,Groep,GenTyp
 Set:'$G(Aantal) Aantal=1
 Set:'$L($G(Munt)) Munt="EUR"
 Set GenTyp=$$GENTYP^HAD(PRNr)
 If (GenTyp="") Do DisplayImg(PRNr) Quit
 Set Groep=$$GenTypeTransform(GenTyp)
 If (Groep?1(1"GRP",1"ASM")) Do DisplayImg(PRNr) Quit
 Set HalID=$P($G(^KPR(PRNr,"G")),D,13)
 If 'HalID Do DisplayImg(PRNr) Quit
 Do STORE^vhTERMINA()
 Set FP=2001 Write @F,@F1
 Set FP=2104 Write @F,"  HALID :"
 Set FP=2115 Write @F,HalID
 Set FP=2144 Write @F,"  Groep :"
 Set FP=2155 Write @F,Groep
 Set FP=2204 Write @F,"   Munt :"
 Set FP=2215 Write @F,Munt
 Set FP=2244 Write @F,"   PRNr :"
 Set FP=2255 Write @F,PRNr
 Set FP=2304 Write @F," Aantal :"
 Set FP=2315 Write @F,Aantal
 Set FP=2007 Write @F,"HALUX\PRODUKT\DISPLAY"
 If $$IO^cQ5()'="1097" Write FP=2007 Write @F,@F2,"HALUX\PRODUKT\DISPLAY"
 Set FP=2001 Write @F,"VBA:\\"
 Read K
 Do REFRESH^vhTERMINA()
 Quit
 
DisplayImg(PRNr)
	#define OLGroep "OL"
	Set IsOrgal=$$ISORGAL^ORGALUX(PRNr)
	If IsOrgal Do
	. Set blMulti=##class(BL.Kenm.ProdMulti).Create($$$OLGroep)
	. Set lbMultiIDs=blMulti.GetMultiplesLB(PRNr)
	. Set KenmID=$LG($G(lbMultiIDs))
	. Set:KenmID="" KenmID=PRNr
	
	Quit:'##class(Res.ImageLink).HasImage("PR",PRNr)&&'(IsOrgal&&$L(##class(cspBasis.ProductList).DataDefValueURL("N",$$$OLGroep,KenmID,"InfoSleutel","LB")))
	New R,K,FP,FilePath,ID
	//Set FilePath="http://cache01/csp/admin1/ProductLinks.csp?PRNR="_PRNr
	set Qstring = $system.Encryption.Base64Encode($system.Encryption.AESEncode("PRNR="_PRNr_"&Taal=N","1q2gg34l5U6p789Q"))
	Set FilePath="http://res.vanhoecke.be/Catalog/Product.aspx?"_Qstring
	Set Url=FilePath
	Do:$L(FilePath)
	. Do STORE^vhTERMINA()
	. ; Oproep Internet Explorer
	. Set Url1=$P(Url,"?")_"?"
	. Set Url2=$P(Url,"?",2,99)
	. Set FP=1801
	. Write @F,@F1
	. Set FP=2007
	. Write @F,"TOOLS\SHELLEXECUTE"
	. Set FP=2101
	. Write @F
	. //Write FilePath
	. Write "iexplore.exe"
	. Set FP=2201
	. Write @F
	. Write Url1
	. Set FP=2301
	. Write @F
	. Write Url2
	. Set FP=2001
	. Write @F,"VBA:\\"
	. Read K:1
	. Do REFRESH^vhTERMINA()
	Quit
	
DisplayDoc(FilePath)
	New R,K,FP,ID
	Set Url=FilePath
	Do:$L(FilePath)
	. Do STORE^vhTERMINA()
	. ; Oproep Internet Explorer
	. Set Url1=$E(Url,1,80)
	. Set Url2=$E(Url,81,999)
	. Set FP=1801
	. Write @F,@F1
	. Set FP=2007
	. Write @F,"TOOLS\SHELLEXECUTE"
	. Set FP=2101
	. Write @F
	. //Write FilePath
	. Write "iexplore.exe"
	. Set FP=2201
	. Write @F
	. Write Url1
	. Set FP=2301
	. Write @F
	. Write Url2
	. Set FP=2001
	. Write @F,"VBA:\\"
	. Read K:1
	. Do REFRESH^vhTERMINA()
	Quit
 
SYNCPR(PRNr) 
 q
 Do STORE^vhTERMINA()
 Set FP=2007 Write @F,@F2,"SYNC\PRODUKT"
 Set FP=2101 Write @F,@F2,"Product : ",PRNr
 Set FP=2001 Write @F,"VBA:\\"
 Read K:1
 Do REFRESH^vhTERMINA()
 Quit
 
PRINTold(ObjTyp,ObjRef,Mode) ; Afdrukken van een orderlijst 
 ;ObjTyp: OFF;ORD;TOE
 ;Mode  : SHOWDLG;PPREVIEW;PRINTSTD;IMMEDIATE
 
 New KLNr,Y,LRec,LNr,Error,TL,TOENr,X,GenList,GenTyp,GenSub
 Set:$G(Mode)="" Mode="PPREVIEW"
 Do STORE^vhTERMINA()
 Set (GenList,Error)=""
 If ObjTyp="ORD" Do  ; Order
 . Set KLNr=$P(^KO1(ObjRef,"F"),D)
 . Set LNr=99
 . For  Set LNr=$O(^KOD(KLNr,"F",ObjRef,LNr)) Quit:LNr=""  Do
 .. Set LRec=^KOD(KLNr,"F",ObjRef,LNr)
 .. Set PRNr=$P(LRec,D,2)
 .. Quit:PRNr'?4.7N
 .. Quit:'$D(^KPR(PRNr,"J6332"))
 .. Set GenTyp=$$GENTYP^HAD(PRNr)
 .. Set GenTyp=$$GenTypeTransform(GenTyp)
 .. Set:GenList'[GenTyp GenList=GenList_";"_GenTyp
 .. Set TOENr=$P(LRec,D,27) 
 .. Set:TOENr="" TOENr="KOM"
 .. Quit:TOENr="KOM"
 .. Set TL(TOENr)=""
 . Set $E(GenList,1)=""
 . Set Y=0
 . Set TOENr=""
 . For  Set TOENr=$O(TL(TOENr)) Quit:TOENr=""  Do 
 .. Set Y=Y+1,Y(Y)=TOENr_"`HALUX"
 . If 'Y Set Error=1 Quit
 . If Y=1 Set TOENr=$P(Y(1),"`") Quit
 . Set X=$$WILD^vhPOPUP("C;C","B1K-","Toelevering",.Y)
 . Set:zb="CANC" Error=1
 . Set TOENr=$S(X:X,1:"")
 If ObjTyp="OFF" Do  ; Offerte
 . Set KLNr=$P(^KOFKL1(ObjRef,"F"),D)
 . Set TOENr=""
 . Set LNr=99
 . For  Set LNr=$O(^KOFKL(KLNr,"F",ObjRef,LNr)) Quit:LNr=""  Do
 .. Set LRec=^KOFKL(KLNr,"F",ObjRef,LNr)
 .. Set PRNr=$P(LRec,D,2)
 .. Quit:PRNr'?4.7N
 .. Quit:'$D(^KPR(PRNr,"J6332"))
 .. Set GenTyp=$$GENTYP^HAD(PRNr)
 .. Set GenTyp=$$GenTypeTransform(GenTyp)
 .. Set:GenList'[GenTyp GenList=GenList_";"_GenTyp
 . Set $E(GenList,1)=""
 If ObjTyp="TOE" Do  ; Toelevering
 . Set LEVNr=$P(^KTO1(ObjRef),D)
 . Set KLNr=$P(^KTO(LEVNr,ObjRef,1),D,8)
 . Set:KLNr="" KLNr=1239
 . Set TOENr=ObjRef
 . Set LNr=99
 . For  Set LNr=$O(^KTO(6332,ObjRef,LNr)) Quit:LNr=""  Do
 .. Set LRec=^KTO(6332,ObjRef,LNr)
 .. Set PRNr=$P(LRec,D,2)
 .. Quit:PRNr'?4.7N
 .. Quit:'$D(^KPR(PRNr,"J6332"))
 .. Set GenTyp=$$GENTYP^HAD(PRNr)
 .. Set GenTyp=$$GenTypeTransform(GenTyp)
 .. Set:GenList'[GenTyp GenList=GenList_";"_GenTyp
 . Set $E(GenList,1)=""
 Quit:GenList=""
 Quit:Error
 Set FP=2001 Write @F,@F1
 Set FP=2104 Write @F,"  ObjTyp:"
 Set FP=2115 Write @F,ObjTyp
 Set FP=2204 Write @F,"  ObjRef:"
 Set FP=2215 Write @F,ObjRef
 Set FP=2244 Write @F,"GenTyp:"
 Set FP=2255 Write @F,GenList
 Set FP=2304 Write @F," KLNr :"
 Set FP=2315 Write @F,KLNr
 Set FP=2344 Write @F," TOENr:"
 Set FP=2355 Write @F,TOENr
 Set FP=2404 Write @F," Mode :"
 Set FP=2415 Write @F,Mode
 Set FP=2007 Write @F,"HALUX\PRINT\ORDER"
 Set FP=2001 Write @F,"VBA:\\"
 Read K
 Do REFRESH^vhTERMINA()
 Quit
 
PRINT(ObjTyp,ObjRef,Mode) ; Afdrukken van een orderlijst 
 ;ObjTyp: OFF;ORD;TOE
 ;Mode  : SHOWDLG;PPREVIEW;PRINTSTD;IMMEDIATE
 
 New KLNr,Y,LRec,LNr,Error,TL,TOENr,X,GenList,GenTyp,GenSub,TOENrs
 Set:$G(Mode)="" Mode="PPREVIEW"
 Do STORE^vhTERMINA()
 Set (GenList,Error)=""
 If ObjTyp="ORD" Do  ; Order
 . Set KLNr=$P(^KO1(ObjRef,"F"),D)
 . Set LNr=99
 . For  Set LNr=$O(^KOD(KLNr,"F",ObjRef,LNr)) Quit:LNr=""  Do
 .. Set LRec=^KOD(KLNr,"F",ObjRef,LNr)
 .. Set PRNr=$P(LRec,D,2)
 .. Quit:PRNr'?4.7N
 .. Quit:'$D(^KPR(PRNr,"J6332"))
 .. Set GenTyp=$$GENTYP^HAD(PRNr)
 .. Set GenTyp=$$GenTypeTransform(GenTyp)
 .. Set:GenList'[GenTyp GenList=GenList_";"_GenTyp
 .. Set TOENr=$P(LRec,D,27) 
 .. Set:TOENr="" TOENr="KOM"
 .. Quit:TOENr="KOM"
 .. Set TL(TOENr)=""
 .. Set TOENrs(TOENr)=GenTyp
 . Set $E(GenList,1)=""
 . Set Y=0
 . Set (TOENr,TOENrs)=""
 . For  Set TOENr=$O(TL(TOENr)) Quit:TOENr=""  Do 
 .. Set Y=Y+1,Y(Y)=TOENr_"`HALUX"
 .. Set TOENrs=TOENrs_";"_TOENr
 . Set $E(TOENrs)=""
 . If 'Y Set Error=1 Quit
 . If Y=1 Set TOENr=$P(Y(1),"`") Quit
 . Set X=$$WILD^vhPOPUP("C;C","B1K-M","Toelevering",.Y,TOENrs)
 . Set:zb="CANC" Error=1
 . Set TOENrs=$S(X:X,1:"")
 If ObjTyp="OFF" Do  ; Offerte
 . Set KLNr=$P(^KOFKL1(ObjRef,"F"),D)
 . Set TOENr=""
 . Set LNr=99
 . For  Set LNr=$O(^KOFKL(KLNr,"F",ObjRef,LNr)) Quit:LNr=""  Do
 .. Set LRec=^KOFKL(KLNr,"F",ObjRef,LNr)
 .. Set PRNr=$P(LRec,D,2)
 .. Quit:PRNr'?4.7N
 .. Quit:'$D(^KPR(PRNr,"J6332"))
 .. Set GenTyp=$$GENTYP^HAD(PRNr)
 .. Set GenTyp=$$GenTypeTransform(GenTyp)
 .. Set:GenList'[GenTyp GenList=GenList_";"_GenTyp
 . Set $E(GenList,1)=""
 If ObjTyp="TOE" Do  ; Toelevering
 . Set LEVNr=$P(^KTO1(ObjRef),D)
 . Set KLNr=$P(^KTO(LEVNr,ObjRef,1),D,8)
 . Set:KLNr="" KLNr=1239
 . Set TOENr=ObjRef
 . Set LNr=99
 . For  Set LNr=$O(^KTO(6332,ObjRef,LNr)) Quit:LNr=""  Do
 .. Set LRec=^KTO(6332,ObjRef,LNr)
 .. Set PRNr=$P(LRec,D,2)
 .. Quit:PRNr'?4.7N
 .. Quit:'$D(^KPR(PRNr,"J6332"))
 .. Set GenTyp=$$GENTYP^HAD(PRNr)
 .. Set GenTyp=$$GenTypeTransform(GenTyp)
 .. Set:GenList'[GenTyp GenList=GenList_";"_GenTyp
 . Set $E(GenList,1)=""
 Quit:GenList=""
 Quit:Error
 Set:'$D(TOENrs) TOENrs=TOENr
 For  Set TOENr=$P(TOENrs,";") Do  Set TOENrs=$P(TOENrs,";",2,99) Quit:TOENrs=""
 . Set GenTyp=GenList
 . If TOENr,$D(TOENrs(TOENr)) Set GenTyp=$G(TOENrs(TOENr))
 . Set FP=2001 Write @F,@F1
 . Set FP=2104 Write @F,"  ObjTyp:"
 . Set FP=2115 Write @F,ObjTyp
 . Set FP=2204 Write @F,"  ObjRef:"
 . Set FP=2215 Write @F,ObjRef
 . Set FP=2244 Write @F,"GenTyp:"
 . Set FP=2255 Write @F,GenTyp
 . Set FP=2304 Write @F," KLNr :"
 . Set FP=2315 Write @F,KLNr
 . Set FP=2344 Write @F," TOENr:"
 . Set FP=2355 Write @F,TOENr
 . Set FP=2404 Write @F," Mode :"
 . Set FP=2415 Write @F,Mode
 . Set FP=2007 Write @F,"HALUX\PRINT\ORDER"
 . Set FP=2001 Write @F,"VBA:\\"
 . Read K
 Do REFRESH^vhTERMINA()
 Quit
 
GenTypeTransform(GenTyp)   ; Added by WimV on 17/10/2005
 New GenSub
 Set GenSub=$P(GenTyp,D,2)
 Set GenTyp=$P(GenTyp,D,1)
 Quit:(GenTyp="") ""
 Set:GenTyp'="TBX" GenTyp="KAD"
 Set:GenSub="POM" GenTyp="GRP"   ; added by WimV
 Set:GenSub="GRP" GenTyp="GRP"
 Set:GenSub="ASM" GenTyp="ASM"
 Set:GenSub="TLM" GenTyp="TLM"
 Quit GenTyp
 
FREEST(TOENr,PRNr) ; Freestool met toelevering of product
 New K
 Do STORE^vhTERMINA()
 Set Error=""
 Set FP=2001 Write @F,@F1
 Set FP=2104 Write @F,"  ObjTyp:"
 Set FP=2115 Write @F,"TOE"
 Set FP=2204 Write @F,"  ObjRef:"
 Set FP=2215 Write @F,$S($G(PRNr):"999999",1:TOENr)
 Set FP=2304 Write @F," PRNr :"
 Set FP=2315 Write @F,$G(PRNr)
 Set FP=2007 Write @F,"HALUX\FREESTOOL"
 Set FP=2001 Write @F,"VBA:\\"
 Read K
 Do REFRESH^vhTERMINA()
 Quit