PRTF ;Produkt Technische fiche [ 11/06/2001  3:41 PM ]
 S Q="K" D ^cA604,INIT^vhTERMINA
PK1 Set FP=101 Write @F,@F1,@FMTI," Technische Fiche : ",QN," ",@FMTi
 Set PRNr=$$SELECT^PRODUKT6() ;"KL",34)
 Quit:'PRNr
 Do EDIT(PRNr)
 Quit
 
EDIT(PRNr) 
 New Input,R,%J,Y,X,KKey,PNr,IsChanged,DL,PRTF,LNr,LKey,Link,Len,Fkey,Format,I,LTNr,INr,MemIKey,MemINr,SubG,Typ,Val,IKey
 Do INIT Quit:'%TC
 Write @F11,@F1
 Do COMMAND,SAVE:IsChanged,CLEAN
 Quit
 
COMMAND ; Lus voor het uitvoeren van de opdrachten
 Set Input=""
 For  Quit:Input="-"!(Input=".")  Do
 .Set DL(3)=3
 .Do REFRESH,SL^PROC
 .Set PNr=PRTF(6)
 .Set Input=R
 .If Input="HELP" Do HELP
 .If Input="ENTER" Do LPOP(PRTF(6))
 .If Input="E" Do LWIJZIG(PRTF(6))
 .If Input="S" Do SHOW            
 .If Input=".",IsChanged Set Input=$$SAVE^vhINP(1)
 .Do REFRESH
 Set sRef("KLAS")=KKey
 Set:Input'="-" IsChanged=0
 Quit
 
INIT ; Locks en Opbouw hulpbestand 
 Kill Y
 Set %TC=0
 Set %J=$$%J^vhRtn1()
 Set R=$O(^KPR(PRNr,"I")) Quit:$E(R)'="I"
 Set KKey=$P(^KPR(PRNr,R),D,4) Quit:'KKey
 Quit:'$$DRN^DD("PRTFK")
 Do KR^DD("hPRTF")
 Do LRN^DD("PRTFK","","+") Quit:'%TC
 Do LRN^DD("PRTF","","+") Quit:'%TC
 Do INIT^PROC("PRTF") Set PRTF(9)=0
 Set Link=-1
 Do COPYBOOM^vhRtn1($$GRN^DD("PRTF"),$$GRN^DD("hPRTF"))
 Do ADDLINK(0)
 Do ADD^vhScherm(1,24)
 Set sRef("KLAS")=KKey
 Set %TC=1
 Set IsChanged=0
 Quit
 
SAVE ; Opslaan van de wijzigingen
 Do KR^DD("PRTF")
 Set PNr=""
 For PNr=1:1:$$ORN^DD("hPRTFP","",-1) Set FKey=$$FF^DD("hPTFKey") Do CR^DD("PRTFF","hPRTFF")
 Do LRN^DD("PRTFK","","-")
 Do LRN^DD("PRTF","","-")
 Quit
 
REFRESH ; Herstellen scherm
 If sRT<4 Do DISPLAY^vhScherm("PRTFHFD",1,4,"H")
 Kill DL Set DL(1)="PRTF"
 If sRB>5 Set:sRT>6 DL(2)=sRT Set:sRB<24 DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
HELP ; Tonen van menu en help
 Set R=""
 Do POP^MN("PRTF")
 Set Input=R
 If Input'="HELP" Do REFRESH Quit
 New HLP
 Set HLP(1)="PRTF"
 Set HLP(3)=9
 Do ^HELP
 Do ADD^vhScherm(9,24)
 Quit
 
CLEAN ; Opkuis en unlock
 Do KR^DD("hPRTF") 
 Do LRN^DD("PRTF","","-")
 Do LRN^DD("PRTFK","","-")
 Quit
 
 ; ***** Verwerking links *****
 ;
ADDLINK(LKey) ; Bijvoegen van de kenmerken van de link
 Set Link=Link+1
 Set Link(Link)=LKey_D_PRTF(9)
AL2 Set LNr="",AddLink=""
 For LNr=1:1:$$ORN^DD("PRTFKL","",-1) Do ADDFLD(LKey,$$FF^DD("PTKFldK"))
 If AddLink Do  Goto AL2
 .Set Link=Link+1
 .Set Link(Link)=+AddLink_D_PRTF(9)
 .Set LKey=+AddLink
 Quit
 
ADDFLD(LKey,FKey) ; Bijvoegen van een kenmerk en de eventuele link
 Set (PNr,PRTF(9))=PRTF(9)+1
 Do SF^DD("hPTFKey",FKey)
 Do SF^DD("hPTLKey",LKey)
 Set IKey=$$GF^DD("hPTIKey")
 If IKey,'$$DRN^DD("PRTFKFI") Do KR^DD("hPRTFF") ; Verwijderen indien item niet meer bestaat
 If '$$DRN^DD("hPRTFF") Do  ; defaulting
 .Set IKey=""
 .For  Set IKey=$$ORN^DD("PRTFKFI") Quit:IKey=""  Do:$$FF^DD("PTKINr")=1
 ..Do TRANS(FKey,IKey,"D")
 ..Set IKey=9999
 If 'AddLink,$$FF^DD("PTKHasL") Do
 .Set IKey=$$GF^DD("hPTIKey")
 .Set AddLink=$$FF^DD("PTKLink")_D_FKey
 Quit
 
UPDLINK(Old,New) ; Bij wijzigen van een kenmerk nakijken of de link moet aangepast worden
 New IKey,LKey
 Quit:Old=New
 If Old Set IKey=Old,LKey=$$FF^DD("PTKLink") If LKey Do REMLINK(LKey)
 If New Set IKey=New,LKey=$$FF^DD("PTKLink") If LKey Do ADDLINK(LKey)
 Do ADD^vhScherm(10,24)
 Quit
 
REMLINK(MemLKey) ; Verwijderen van de velden van een link
 For Link=Link:-1:1 Do  Set PRTF(9)=$P(Link(Link),D,2) Kill Link(Link) Quit:LKey=MemLKey 
 .Set LKey=+Link(Link)
 .For PNr=PRTF(9):-1:$P(Link(Link),D,2)+1 Do KR^DD("hPRTFP")
 Set Link=$O(Link(""),-1)
 Quit
 
SHOW 
 Do DISPLAY^vhScherm("PRTFSHOW",9,24,1)
 Do ADD^vhScherm(9,24)
 Kill IK Do IK^PROC1
 Quit
 ; Wijzigen kenmerk
 ;
LPOP(PNr) ; Popup met de mogelijke pregedefinieerde items
 New X,Y
 Set FKey=$$FF^DD("hPTFKey")
 Set IKey=""
 For  Set IKey=$$ORN^DD("PRTFKFI") Quit:IKey=""  Set Y($$FF^DD("PTKINr"))=$$FF^DD("PTKKode")_$J("",20-$L($$FF^DD("PTKKode")))_" | "_$$FF^DD("PTKOmsN")_D_IKey
 Set Y(0)=$O(Y(""),-1)        
 Set Y="15\\Mogelijke waarden voor kenmerk : "_$$FF^DD("PTKPrmp")
 Set IKey=$$FF^DD("hPTIKey"),X=$$FF^DD("PTKINr")
 Do:Y(0)>1 ^POP
 If 'X Quit
 Do UPDLINK(IKey,$P(Y(X),D,2))
 Do TRANS(FKey,$P(Y(X),D,2),$S(IKey=$P(Y(X),D,2):"E",1:"N"))
 Do EL^PROC
 Do DISPLAY^vhScherm("PRTFHFD",1,4,"H","3;4;5;6")
 Set IsChanged=1
 Quit
 
LWIJZIG(PNr) ; Wijzigen via ingave door de gebruiker
 Set FKey=$$FF^DD("hPTFKey")
 Set IKey=$$FF^DD("hPTIKey")
 Quit:$$FF^DD("PTKEdit")=""
 Do TRANS(FKey,IKey,"E")
 Do EL^PROC
 Do DISPLAY^vhScherm("PRTFHFD",1,4,"H","3;4;5;6")
 Set IsChanged=1
 Quit
 
 ; ***** Formatering *****
 ;
FMTKT(Taal) ; Formatering korttekst
 New P,PNr,Fmt,Val,T,X,INr
 ;Set $ZT="FMTTRAP^PRTF"
 For I=Link:-1:0 Set LKey=$P(Link(I),D) If $$DRN^DD("PRTFKLT") Set Format=$$FF^DD("PTKKT") Quit 
 Set Format=$G(Format)
 Set T=""
 ;If $L(Format) Set SubG=$$FF^DD("PKKSKode") Set:$E(SubG,$L(SubG)-1,SubG)'="BL" T=$E($$FF^DD("PKKHKode"),1)_$E($$FF^DD("PKKGKode"),1)_$E($$FF^DD("PKKSKode"),2-($$FF^DD("PKKGKode")=$$FF^DD("PKKSKode")))_"."
 For I=1:1:$L(Format,";") Do
 .Set FKey=$P(Format,";",I) Quit:FKey=""
 .Set X=$$GF^DD("hPTKode")
 .If $L($$FF^DD("PTKTran")) X "S X="_$$FF^DD("PTKTran")
 .Set X=$E(X,1,$$FF^DD("PTKLen")),X=X_$J("",$$FF^DD("PTKLen")-$L(X))
 .If X'="" Set T=T_X
 Set $P(sFL(2),D,1)=T
 Quit
 
FMTLT(Taal) ; Formatering langtekst (taal afhankelijk)
 New P,PNr,Fmt,Val,T,X,INr
 Set LTNr=1,LLen=26
 Set $ZT="FMTTRAP^PRTF"
 For I=Link:-1:0 Set LKey=$P(Link(I),D) If $$DRN^DD("PRTFKLT") Set Format=$$FF^DD("PTKLT") Quit 
 Set Format=$G(Format),T=""
 ;If $L(Format) Set KSS=$$GETSORT^KLASS(KKey),T=$$FF^DD("oPKSOms"_Taal),$P(sFL(2),D,LTNr+1)=T
 For I=1:1:$L(Format,";") Do
 .Set FKey=$P(Format,";",I) Quit:FKey=""
 .Set X=$$GF^DD("hPTOms"_Taal)
 .Set Separ=$S($L(T):",",1:"")
 .If X'="" Do
 ..If $L(T)+$L(X)+$L(Separ)'>LLen Set T=T_Separ_X
 ..Else  If $L(T)>(LLen-10) Set T=X,LTNr=LTNr+1,LLen=45
 ..Else  If LTNr<3 Do  ;Splitsen van woorden
 ...For  Quit:$L(T)+$L($P(X," ",1))+$L(Separ)>LLen  Set T=T_Separ_$P(X," ",1),X=$P(X," ",2,99),Separ=" "
 ...Set $P(sFL(2),D,LTNr+1)=T
 ...Set T=X,LTNr=LTNr+1,LLen=45
 ..Quit:LTNr>3
 ..Set $P(sFL(2),D,LTNr+1)=T
 Quit
 
FMTTRAP Do TXT^vhINP("Foutieve formatering in korttekst of langtekst")
 Quit
 
 ; ***** Ingave/Validatie kenmerk *****
 ;
PREEDIT ; Nakijken of het korttekst veld moet ingevuld worden
 Set LTNr=0
 For I=Link:-1:0 Set LKey=$P(Link(I),D) If $$DRN^DD("PRTFKLT") Set Format=$$FF^DD("PTKKT") Quit 
 If ";"_$G(Format)_";"[(";"_FKey_";") Quit
 If $L($$FF^DD("PTKFmtN")) Quit
 Set sEr=-1
 Quit
 
VALKT(X) ; Validatie van de ingave van de kode voor de korttekst
 If $$FF^DD("PTKLen"),$$FF^DD("PTKLen")<$L(X) Set sEr="Ingave mag max. "_$$FF^DD("PTKLen")_" karakters bevatten" Quit
 ;If $L($$FF^DD("PTKTran")) X $$FF^DD("PTKTran")
 Quit
 ;
TRANS(FKey,IKey,Mode) ; Defaulting
 Set Kode=$$FF^DD("PTKKode")
 Set OmsN=$$FF^DD("PTKOmsN")
 Set OmsF=$$FF^DD("PTKOmsF")
 Set OmsD=$$FF^DD("PTKOmsD")
 Set Edit=$$FF^DD("PTKEdit")
 If Mode'="D" Do
 .If Edit="K" Do  ; Kode editeerbaar
 ..Set X=$$GF^DD("hPTKode") Set:'$L(X) X=Kode
 ..Set Kode=X
 ..Set X=$$ASK^vhINP($$FF^DD("PTKPrmp")_" : ",20,X)
 ..Set:X'="-"&(X'=".") Kode=X
 .If Edit="O"!(Edit="A") Do  ; Omschrijving editeerbaar
 ..If Mode="E" Do
 ...Set X=Kode,Kode=$$GF^DD("hPTKode") Set:'$L(Kode) Kode=X
 ...Set OmsN=$$GF^DD("hPTOmsN")
 ...Set OmsF=$$GF^DD("hPTOmsF")
 ...Set OmsD=$$GF^DD("hPTOmsD")
 ..Set:Edit="O" X=""
 ..Do:Mode="N" NIEUW^vhScherm("PRTFDTL")
 ..Do:Mode'="N" EDIT^vhScherm("PRTFDTL")
 If "K"[Edit Do  ; Langtekst transformatie
 .Set OmsN=$$TRANSLT(OmsN,Kode)
 .Set OmsF=$$TRANSLT(OmsF,Kode)
 .Set OmsD=$$TRANSLT(OmsD,Kode)
 Do SF^DD("hPTKode",Kode)
 Do SF^DD("hPTOmsN",OmsN)
 Do SF^DD("hPTOmsF",OmsF)
 Do SF^DD("hPTOmsD",OmsD)
 Do SF^DD("hPTIKey",IKey)
 Quit
TRANSLT(Fmt,Kode) 
 Set I=$F(Fmt,"@")
 Quit:'I Fmt
 Set $E(Fmt,I-1)=Kode
 Quit Fmt
 
TRANSKT(X) ; Trasformatie van de korttekstkode naar de langtekst omschrijving
 New INr
 Set INr="" ; Defaulting dmv itemlijst
 For INr=1:1:$$ORN^DD("PRTFKFL","",-1) If X=$$FF^DD("PTKKode") Do  Quit
 .Do PUT^vhScherm(2,$$FF^DD("PTKOmsN"))
 .Do PUT^vhScherm(3,$$FF^DD("PTKOmsF"))
 .Do PUT^vhScherm(4,$$FF^DD("PTKOmsD"))
 .Set INr=-1
 Quit:INr=-1
 Do TRANSOMS("N",2,X)
 Do TRANSOMS("F",3,X)
 Do TRANSOMS("D",4,X)
 Quit
TRANSOMS(Taal,Veld,Kode) 
 New Fmt,Val,X
 Set Fmt=$$FF^DD("PTKFmt"_Taal) Set:'$L(Fmt) Fmt=$$FF^DD("PTKFmtN")
 If $L(Fmt) Do
 .Set (X,Val)=$$GET^vhScherm(Veld)
 .If $L(Val) Set X=$$GET^vhScherm(1) X Fmt
 .If X=Val Set X=Kode X Fmt Do PUT^vhScherm(Veld,X)
 Quit