PRTFK ;Produkt Technische fiche Klassificatie [ 11/06/2001  3:43 PM ]
 ; Entry via EDIT^PRTFK(KKey)
 ;
 S Q="K" D ^cA604,INIT^vhTERMINA ;S:'$D(sRef("KLAS")) sRef("KLAS")=2
PK1 Set FP=101 Write @F,@F1,@FMTI," Technische Fiche Definitie : ",QN," ",@FMTi
 Set KKey=$$SELECT^KLASS(3)
 Quit:'KKey
 Set KKey=+KKey
 If '$$DRN^DD("PRTFK") Goto PK1:$$ASK^vhINP("Wilt U een nieuwe technische fiche kreeren : ",1,"J")'="J"
 Set sRef("KLAS")=KKey
 Do EDIT(KKey)
 Quit
 
EDIT(KKey) New Input,R,DL,FL,PRTFK,PNr,HasL,I,INr,IsChange,LIST,KGS,KHS,PNr,MemKey,MaxP,Link,LTNr,LNr,LKey,LK,X,FKey,%J
 Do INIT Quit:'%TC
 Write @F11,@F1
 Do COMMAND,SAVE:IsChanged,CLEAN
 Quit
 
COMMAND ; Lus voor uitvoeren van de opdrachten
 Set Input=""
 For  Quit:Input="-"!(Input=".")  Do
 .Set DL(3)=3
 .Do REFRESH,SL^PROC
 .Set Input=R
 .Set PNr=PRTFK(6)
 .If Input="HELP" Do HELP
 .If Input="N" Do LNIEUW(),LIJST,EL^PROC
 .If Input="D" Do LDUPLI
 .If Input="C" Do COPY
 .If Input="P" Do PRODUKT
 .If $$GF^DD("hPTKLKey")=Link(Link),$$FF^DD("hPTKFKey") Do
 ..If Input="E" Do LWIJZIG(PRTFK(6))
 ..If Input="<" Do LSWAP("UP")
 ..If Input=">" Do LSWAP("DO")
 ..If Input="V" Do LDELETE
 ..If Input="I" Do LINSERT,LIJST,EL^PROC
 ..If Input="ENTER" Set FKey=$$GF^DD("hPTKFKey") Do LIJST,EL^PROC
 .If Input="," Do UNLINK
 .If Input=".",IsChanged Set Input=$$SAVE^vhINP(1)
 .If Input="K" Do POPKT
 .If Input="L" Do POPLT
 Set:Input'="-" IsChanged=0
 Quit
 
INIT ; Opbouw hulpbestand
 Do LRN^DD("PRTFK") Quit:'%TC  
 Kill Y
 Set %J=$$%J^vhRtn1()
 Do KR^DD("hPRTFK")
 If '$$DRN^DD("PRTFK") Do  ; Nieuw
 .Do SR^DD("hPRTFK","0\0\0")
 If $$DRN^DD("PRTFK") Do  ; Wijzig
 .Do CR^DD("hPRTFK","PRTFK")
 .Set (FKey,IKey)=""
 .For  Set FKey=$$ORN^DD("PRTFKF") Quit:FKey=""  Do
 ..Do CR^DD("hPRTFKF","PRTFKF")
 ..;Set IKey=999
 ..For  Set IKey=$$ORN^DD("PRTFKFI") Quit:IKey=""  Do
 ...Set INr=$$FF^DD("PTKINr")
 ...Do CR^DD("hPRTFKFI","PRTFKFI")
 ...Do SF^DD("hPTKIKey",IKey)
 .Do COPYBOOM^vhRtn1($$GRN^DD("PRTFKL",-3),$$GRN^DD("hPRTFKL",-3))
 .Set LKey=0,LNr=""
 .For LNr=1:1:$$ORN^DD("PRTFKL","",-1) Do 
 ..Set PNr=LNr
 ..Do CF^DD("hPTKFKey","PTKFldK")
 ..Do SF^DD("hPTKLKey",LKey)
 Set LKey=0
 Set Link=0,Link(Link)=0
 Do INIT^PROC("PRTFK")
 Set PRTFK(2,1)=^LD("L","PRTFKBLANK")
 Do ADD^vhScherm(1,24)
 Set sRef("KLAS")=KKey
 Set IsChanged=0
 Quit
 
SAVE ;Opslaan gewijzigde gegevens
 B
 For  Do DELLINK Quit:Link<0
 B
 Do KR^DD("PRTFK")
 Quit:'$$DRN^DD("hPRTFKF",-1)
 Do CR^DD("PRTFK","hPRTFK")
 Set FKey=""
 For  Set FKey=$$ORN^DD("hPRTFKF") Quit:FKey=""  Do
 .Do CR^DD("PRTFKF","hPRTFKF")
 .Set INr=""
 .For INr=1:1:$$ORN^DD("hPRTFKFI","",-1) Do
 ..Set IKey=$$FF^DD("hPTKIKey")
 ..Do CR^DD("PRTFKFI","hPRTFKFI")
 ..Do SF^DD("PTKINr",INr)
 Do COPYBOOM^vhRtn1($$GRN^DD("hPRTFKL",-3),$$GRN^DD("PRTFKL",-3))
 Quit
 
CLEAN ; Opkuis hulpbestand en unlock
 Do KR^DD("hPRTFK")
 Do LRN^DD("PRTFK","","-")
 Quit
 
REFRESH 
 If sRT<9 Do DISPLAY^vhScherm("PRTFKHFD",1,4,"H")
 Kill DL Set DL(1)="PRTFK"
 If sRB>8 Set:sRT>8 DL(2)=sRT Set:sRB<24 DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
HELP ; Oproep van Menu en HELP
 Set R=""
 Do POP^MN("PRTFK")
 Set Input=R
 If Input'="HELP" Do REFRESH Quit
 New HLP
 Set HLP(1)="PRODUKT FICHE KLAS"
 Set HLP(3)=9
 Do ^HELP
 Do ADD^vhScherm(9,24)
 Quit
 
COPY ; Copieren van een technische fiche van een andere subgroep.
 New CKey
 If $$DRN^DD("hPRTFKP",-1) Do TXT^vhINP("Dupliceren alleen toegelaten indien","er nog geen kenmerken zijn ingevuld") Quit
 Set CKey=+$$SELECT^KLASS(3,"","","","Copy van klassificatie")
 Quit:'CKey
 Do COPYTREE^vhRtn1(CKey,KKey,$$GRN^DD("PRTFK",-1))
 Do INIT
 Set IsChanged=1
 Do LRN^DD("PRTFK","","-")
 Quit
 
PRODUKT New KHS,KGS,KSS,Max,PROD,DL,Kort,%J
 Set %J=$$%J^vhRtn1()
 Set KHS=$$GETSORT^KLASS(KKey,1)
 Set KGS=$$GETSORT^KLASS(KKey,2)
 Set KSS=$$GETSORT^KLASS(KKey,3)
 Set Max=0
 Do INIT^PROC("PRTFKPROD","PROD")
 Set PROD(9)=$$MORE^KLASB(0,PROD(4),"")
 Do WL^PROC,SL^PROC,ADD^vhScherm(PROD(3),24)
 Kill ^HULP(%J)
 Quit
 
LWIJZIG(PNr) ; Wijzigen van een kenmerk
 Goto LNIEUW2:'$$DRN^DD("hPRTFKP")
 Set FKey=$$GF^DD("hPTKFKey")
 Goto LNIEUW2:'FKey
 Do EDIT^vhScherm("PRTFKDTL"),EL^PROC
 Do REFRESH
 Do DISPLAY^vhScherm("PRTFKHFD",1,4,"H","2;3;4;5")
 Set IsChanged=1
 Quit
 
LNIEUW(PNr)  ; Nieuw kenmerk achteraan bijvoegen
 Do NIEUW^PROC3
 Set PNr=PRTFK(6)
LNIEUW2 Set FKey=$$GF^DD("hPTKFKey")
 If 'FKey Set FKey=$$FF^DD("hPTKLFNr")+1 Do SF^DD("hPTKLFNr",FKey),SF^DD("hPTKFKey",FKey),SF^DD("hPTKLKey",Link(Link))
 Do NIEUW^vhScherm("PRTFKDTL")
 If '%SC Do DELETE^PROC3,KR^DD("hPRTFKF") Quit
 Do DL^PROC
 Kill PRTFK(7) Set PRTFK(6)=PNr Set:PRTFK(9)<PNr PRTFK(9)=PNr
 Do EL^PROC
 Set IsChanged=1
 Quit
 
LINSERT ; Tussenvoegen van een nieuw kenmerk
 Do INSERT^PROC3
 Set PNr=PRTFK(6)
 Do LNIEUW2
 Quit
 
LDELETE ; Verwijderen van een kenmerk
 New FKey,LKey
 Set FKey=$$GF^DD("hPTKFKey")
 Set LKey=$$GF^DD("hPTKLKey")
 Do REMFLD(FKey)
 Do DELETE^PROC3 ; Opkuis in "P"
 Set LNr="",LMax=$$ORN^DD("hPRTFKL","",-1)
 For LNr=1:1:LMax If FKey=$$FF^DD("hPTKFldK") Do LDELETE^PROC3(LNr,LMax,$$GRN^DD("hPRTFKL",-1)) Quit
 Set LKey=Link(Link)
 Do DISPLAY^vhScherm("PRTFKHFD",1,4,"H","2;3;4;5")
 Set IsChanged=1
 Quit
 
LDUPLI ; Dupliceren van een kenmerk 
 Set OldKey=$$GF^DD("hPTKFKey")
 Set FKey=$$FF^DD("hPTKLFNr")+1 Do SF^DD("hPTKLFNr",FKey)
 Do COPYTREE^vhRtn1(OldKey,FKey,$$GRN^DD("hPRTFKF",-1))
 Set INr="",IKey=$$FF^DD("hPTKLINr")
 For INr=1:1:$$ORN^DD("hPRTFKFI","",-1) Do SF^DD("hPTKLink",""),SF^DD("hPTKIKey",IKey+INr)
 Do SF^DD("hPTKLINr",IKey+INr)
 Do SF^DD("hPTKDef",""),SF^DD("hPTKHasL","")
 Do DUPLI^PROC3
 Set PNr=PRTFK(6)
 Do SF^DD("hPTKFKey",FKey)
 Do SF^DD("hPTKLVal","")
 Do SF^DD("hPTKLOrg","")
 Set IsChanged=1
 Do LWIJZIG(PNr)
 Quit
 
LSWAP(Dir) ; Verplaatsen van een kenmerk
 Set PNr=PNr+$S(Dir="UP":-1,1:1)
 Quit:$$GF^DD("hPTKLKey")'=Link(Link)
 Quit:$$GF^DD("hPTKFKey")=""
 Do SWAP^PROC3(Dir)
 Set IsChanged=1
 Quit
 
CALLB(Nr,Ref) ; Callback voor de PRTFK lijst
 If '$P(FL(3),"\"),$P(FL(3),"\",2) Set FL(3)="--------------------------" Quit 1
 N PNr,FKey,INr
 S PNr=DLv,FKey=$$FF^DD("hPTKFKey")
 S (FL(3,1),FL(3,2),FL(3,3))=""
 Quit:'FKey ""
 S FL(3,1)=$$GR^DD("hPRTFKF")
 S INr=1,FL(3,2)=$$GR^DD("hPRTFKFI") ;Default
 S INr=$$FF^DD("hPTKDef"),FL(3,3)=$S('INr:$$FF^DD("hPTKHasL"),1:$$GR^DD("hPRTFKFI")_D)
 Quit ""
 ;
 ; *****  Kenmerk itemlijst  *****
 ;
LIJST ;Tonen van de lijst en editeren van de lijst, opgeroepen vanuit COMMAND
 Do LIJSTED
 Do ADD^vhScherm(LIST(3),24)
 Do DISPLAY^vhScherm("PRTFKHFD",1,4,"H","2;3;4;5")
 Quit
 
LIJSTED ; Tonen en editeren van de lijst, opgeroepen vanuit LWIJZIG
 New DL,Input,X,sFL
 Do INIT^PROC("PRTFKLIST","LIST")
 Do RESET^vhScherm,ADD^vhScherm(16,24)
 Set Input=""
 For  Quit:Input="-"!(Input=".")  Do
 .Do LREFRESH,SL^PROC
 .Set INr=LIST(6)
 .Set Input=R
 .If R="HELP" Set R="" Do POP^MN("PRTFKLIJST"),HELP:R="HELP",LREFRESH
 .Set Input=R
 .If Input="HELP" Do HLP^HELP("Produkt Fiche")
 .If Input="ENTER",$$DRN^DD("hPRTFKFI") Do EDIT^vhScherm("PRTFKLIST")
 .If Input="N"!(Input="ENTER"&'$$DRN^DD("hPRTFKFI")) Do NIEUW^PROC3,NIEUW^vhScherm("PRTFKLIST"),DELETE^PROC3:'%SC
 .If Input="I" Do INSERT^PROC3,NIEUW^vhScherm("PRTFKLIST"),DELETE^PROC3:'%SC
 .If Input="V" Do REMLINK($$FF^DD("hPTKLink")),DELETE^PROC3 Set IsChanged=1
 .If Input=">" Do SWAP^PROC3("DO")
 .If Input="<" Do SWAP^PROC3("UP")
 .If Input="C" Do ADDLINK(INr),ADD^vhScherm(1,24) Set Input="."
 .If "<,>,I,N,ENTER"[Input Set:%SC IsChanged=1
 Set INr="",HasL=0
 For INr=1:1:$$ORN^DD("hPRTFKFI","",-1) If $$FF^DD("hPTKLink") Set HasL=1 Quit
 Do SF^DD("hPTKHasL",HasL)
 Do ADD^vhScherm(16,24)
 
 Quit
    
LREFRESH ; Herstellen itemlijst
 Do:sRB=24 WL^PROC
 Do RESET^vhScherm
 Quit
 
LINK ; PopUp voor het selekteren van een link (niet meer gebruikt)
 New Y
 Set FKey=$$FF^DD("hPTKFKey")
 Set FL(1)=^LD("L","PRTFKLIST"),FL(2)=""
 Set FL(5)=^LD("L","PRTFKLIST","E")
 Set Y(0)=0,INr=""
 For INr=1:1:$$ORN^DD("hPRTFKFI","",-1) Set DLv=INr,Y(0)=Y(0)+1,FL(3)=$$FR^DD("hPRTFKFI") Do FL^PROC Set Y(Y(0))=R_D_INr
 Quit:'Y(0)
 Set Y="18\B\Selecteer waarde voor ingave conditionele kenmerken"
 Do ^POP
 Quit:X=""
 Do ADDLINK(X)
 Do ADD^vhScherm(1,24)
 Quit
 
ADDLINK(INr) ; Bijvoegen van de kenmerken voor het gekozen item van een kenmerk
 Set LKey=$$FF^DD("hPTKLink")
 Set Link=Link+1,Link(Link)=LKey
 If 'LKey Set (Link(Link),LKey)=$$FF^DD("hPTKLLNr")+1 Do SF^DD("hPTKLLNr",LKey),SF^DD("hPTKLink",LKey)
 Do SF^DD("hPTKLOrg",LKey)
 Do SF^DD("hPTKDef",INr)
 Set PNr=""
 Set MaxP=$$ORN^DD("hPRTFKP","",-1)
 Set PNr=MaxP+1 Do SR^DD("hPRTFKP",D_LKey_D_FKey_D_$$FF^DD("hPTKKode")_","_$$FF^DD("hPTKOmsN"))
 Set LNr=""
 For LNr=1:1:$$ORN^DD("hPRTFKL","",-1) Set PNr=MaxP+LNr+1 Do SR^DD("hPRTFKP",$$FF^DD("hPTKFldK")_D_LKey)
 Set PRTFK(9)=PNr
 Set PNr=MaxP+2 Set PRTFK(6)=$S($$DRN^DD("hPRTFKP"):PNr,1:PNr-1) 
 Quit
UNLINK ; Verwijderen van de laatste gekreeerde link, opgeroepen vanuit COMMAND
 If Link=0 Set Input="." Quit
 Do DELLINK
 Do ADD^vhScherm(1,24)
 Quit
 
DELLINK ; Terug afbouwen van de laatst gekreeerde link
 B
 Set LKey=Link(Link)
 Kill Link(Link) Set Link=Link-1
 Do KR^DD("hPRTFKL",-1)
 Set LNr=0,PNr=""
 For PNr=1:1:$$ORN^DD("hPRTFKP","",-1) Do
 .If $$FF^DD("hPTKLOrg")=LKey Do SF^DD("hPTKLOrg",""),SF^DD("hPTKLVal","") Set MemKey=$$FF^DD("hPTKFKey")
 .If $$FF^DD("hPTKLKey")=LKey Set FKey=$$FF^DD("hPTKFKey") Do KR^DD("hPRTFKP") If FKey Set LNr=LNr+1 Do SF^DD("hPTKFldK",FKey)
 Set PRTFK(9)=PRTFK(9)-LNr-1,PRTFK(6)=$S(PRTFK(6)>PRTFK(9):PRTFK(9),1:PRTFK(6))
 If LNr=0 Do KR^DD("hPRTFKLT") ; Verwijderen van de Formatering
 Quit:Link<0  ; Niet voor basis
 ; Nakijken of er links zijn
 ; en verwijderen van de link indien er geen fields zijn (LNr=0)
 Set HasL=0 ; Nakijken of er links zijn
 Set FKey=MemKey,INr=""
 For INr=1:1:$$ORN^DD("hPRTFKFI","",-1) Do
 .Set LK=$$FF^DD("hPTKLink")
 .If 'LNr,LK=LKey Set LK="" Do SF^DD("hPTKLink",LK)
 .Set:LK HasL=1
 Do SF^DD("hPTKHasL",HasL)
 Do SF^DD("hPTKDef","")
 Quit
 
 ; **** Verwijderen veld en daarbij behorende links (recursief)
 ;
REMFLD(FKey) ; Verwijderen links van de items een daarna het kenmerk
 Quit:'FKey
 New INr,LKey
 Set INr=""
 For INr=1:1:$$ORN^DD("hPRTFKFI","",-1)  Do REMLINK($$FF^DD("hPTKLink"))
 Do KR^DD("hPRTFKF")
 Set LKey=""
 For  Set LKey=$$ORN^DD("hPRTFKLT",-1) Quit:LKey=""  Do REMTXT("KT",LKey,FKey),REMTXT("LT",LKey,FKey)
 Quit
 
REMLINK(LKey) ; Verwijderen van kenmerken van een link en daarna de link
 Quit:'LKey
 New LNr
 Set LNr=""
 For LNr=1:1:$$ORN^DD("hPRTFKL","",-1) Do REMFLD($$FF^DD("hPTKFldK"))
 Do KR^DD("hPRTFKL",-2)
 Quit
 
REMTXT(Veld,LKey,FKey) ; Verwijderen kenmerk uit formateringslijst
 New Txt
 Set Txt=";"_$$GF^DD("hPTK"_Veld)_";"
 Set FKey=";"_FKey_";"
 Quit:Txt'[FKey
 Set Txt=$P(Txt,FKey)_";"_$P(Txt,FKey,2)
 Set Txt=$E(Txt,2,$L(Txt)-1)
 Do SF^DD("hPTK"_Veld,Txt)
 Quit 
 
 ;
 ;--- Formatering Kortekst, langtekst
 ;
POPKT ; Popup voor selectie van de kenmerken waaruit de korttekst is opgebouwd
 New Y,X
 Set LKey=Link(Link)
 Set KeyList=";"_$$GF^DD("hPTKKT")_";" Set:KeyList=";;" KeyList=""
 Set Y(0)=0,PNr=""
 For PNr=1:1:$$ORN^DD("hPRTFKP","",-1) Do
 .Set FKey=$$FF^DD("hPTKFKey")
 .Quit:'FKey
 .Set I=$L($E(KeyList,1,$F(KeyList,";"_FKey_";")),";")
 .Set Y(0)=Y(0)+1
 .Set Y(Y(0))=$$FF^DD("hPTKPrmp")_"\"_FKey
 .Set:I>1 $P(X,";",I-2)=Y(0)
 Set Y="10\MV\Selecteer kenmerken voor de korttekst"
 Do ^POP
 Quit:"-"=X
 Set KeyList=""
 If X'="" For I=1:1:$L(X,";") Set KeyList=KeyList_";"_$P(Y($P(X,";",I)),"\",2)
 If $$GF^DD("hPTKKT")=$E(KeyList,2,99) Quit
 Do SF^DD("hPTKKT",$E(KeyList,2,99))
 Do:$TR($$GR^DD("hPRTFKLT"),"\","")="" KR^DD("hPRTFKLT")
 Do REFRESH
 Do DISPLAY^vhScherm("PRTFKHFD",1,4,"H",2)
 Set IsChanged=1
 Quit
 
POPLT ; Popup voor selectie van de kenmerken waaruit de langtekst is opgebouwd
 New Y,X
 Set LKey=Link(Link)
 Set KeyList=";"_$$GF^DD("hPTKLT")_";" Set:KeyList=";;" KeyList=""
 Set Y(0)=0,PNr=""
 For PNr=1:1:$$ORN^DD("hPRTFKP","",-1) Do
 .Set FKey=$$FF^DD("hPTKFKey")
 .Quit:'FKey
 .Set I=$L($E(KeyList,1,$F(KeyList,";"_FKey_";")),";")
 .Set Y(0)=Y(0)+1
 .Set Y(Y(0))=$$FF^DD("hPTKPrmp")_"\"_FKey
 .Set:I>1 $P(X,";",I-2)=Y(0)
 Set Y="10\MV\Selecteer kenmerken voor de langtekst"
 Do ^POP
 Quit:"-"=X
 Set KeyList=""
 If X'="" For I=1:1:$L(X,";") Set KeyList=KeyList_";"_$P(Y($P(X,";",I)),"\",2)
 If $$GF^DD("hPTKLT")=$E(KeyList,2,99) Quit
 Do SF^DD("hPTKLT",$E(KeyList,2,99))
 Do:$TR($$GR^DD("hPRTFKLT"),"\","")="" KR^DD("hPRTFKLT")
 Do REFRESH
 Do DISPLAY^vhScherm("PRTFKHFD",1,4,"H","3;4;5")
 Set IsChanged=1
 Quit
 
FMTKT(Format,SelKey,Value) ; Formatering van de korttekst
 New P,PNr,Fmt,Val,T,X,INr
 Set INr=1
 Set $ZT="FMTTRAP^PRTFK"
 If '$D(Format) For I=Link:-1:0 Set LKey=Link(I) If $$DRN^DD("hPRTFKLT") Set Format=$$FF^DD("hPTKKT") 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=""
 .If FKey=$G(SelKey) Set X=Value
 .Else  Set INr=$$FF^DD("hPTKDef") Set:'INr INr=1 Set X=$$GF^DD("hPTKKode")
 .If $L($$FF^DD("hPTKTran")) X "S X="_$$FF^DD("hPTKTran")
 .Set X=$E(X,1,$$FF^DD("hPTKLen")),X=X_$J("",$$FF^DD("hPTKLen")-$L(X))
 .If X'="" Set T=T_X
 Set $P(sFL(2),D,1)=T
 Quit
 
FMTLT(Format,SelKey,Value) ; Formatering van de langtekst
 New P,PNr,Fmt,Val,T,X,INr
 Set INr=1,LTNr=0
 ;Set $ZT="FMTTRAP^PRTFK"
 If '$D(Format) For I=Link:-1:0 Set LKey=Link(I) If $$DRN^DD("hPRTFKLT") Set Format=$$FF^DD("hPTKLT") Quit 
 Set Format=$G(Format)
 Set T=""
 ;If $L(Format) Set KSS=$$GETSORT^KLASS(KKey),T=$$FF^DD("oPKSOmsN"),$P(sFL(2),D,LTNr+1)=T
 For I=1:1:$L(Format,";") Do
 .Set FKey=$P(Format,";",I) Quit:FKey=""
 .If FKey=$G(SelKey) Set X=Value
 .Else  Set INr=$$FF^DD("hPTKDef") Set:'INr INr=1 Set X=$$GF^DD("hPTKOmsN")
 .If X'="" Do
 ..Set T=T_","_X
 ..If $L(T)>$S(LTNr=0:-1,LTNr=1:26,1:45) Set T=X,LTNr=LTNr+1
 ..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 *****
 ;
VALKT(X) ; Validatie bij ingave korttekst kode voor een item van een kenmerk
 Set $ZT="FMTTRAP^PRTFK"
 If $$FF^DD("hPTKTyp")["N",(X'?.N.1",".2N) Set sEr="Foutieve ingave, moet numeriek zijn" Quit
 If $$FF^DD("hPTKLen")<$L(X) Set sEr="Ingave mag max. "_$$FF^DD("hPTKLen")_" karakters bevatten" Quit
 ;If $L($$FF^DD("hPTKFmt")) X $$FF^DD("hPTKFmt")
 Quit
 
TRANSKT(X) ; Translatie van een kode naar omschrijving voor langtekst in de verschillende talen
 Do TRANS("N",2,X)
 Do TRANS("F",3,X)
 Do TRANS("D",4,X)
 Quit
TRANS(Taal,Veld,Kode) 
 New Fmt,Val,X
 Set Fmt=$$FF^DD("hPTKFmt"_Taal) Set:'$L(Fmt) Fmt=$$FF^DD("hPTKFmtN")
 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