SD ;NEW PROGRAM [ 11/07/2001  1:46 PM ]
 D INIT^vhTERMINA
SD1 Set FP=101 Write @F,@F1,@FMTI,"Scherm beheer : ",QN,@FMTi
 Set X1=$G(sRef("SD"))
SD2 Set X1=$$ASK^vhINP("Scherm : ",30,X1,"","De eerste letters van de schermnaam, *[] = Nieuw")
 Quit:X1="-"
 Goto SD2:X1=""
 I X1="*" Goto NIEUW
 S (X2,X1)=$$UPCASE^vhRtn1(X1) I $D(^SD("D",X1)),$E($O(^SD("D",X1)),1,$L(X1))'=X1 Goto SD3
 Goto SD1:$E($O(^SD("D",X2)),1,$L(X1))'=X1
 Set Y(0)=0
 If $D(^SD("D",X1)) S X2=$O(^SD("D",X1),-1)  ;Y(0)=1,Y(1)=X2_$J("",15-$L(X2))_"| "_$P(^SD("D",X2),"`",2)_D_X2
 S Y="20\\Select scherm\\FMORE^SD",X=""
 Set Y(0)=$$FMORE(0,5)
 Do ^POP
 If X S X1=$P(Y(X),D,2) Goto SD3
 Goto SD1
SD3 Set Scherm=X1
 Goto EDIT
 
FMORE(Max,Len,Ref) 
 Quit:X2=-1 Max
 For J=1:1:Len S X2=$O(^SD("D",X2)) Quit:X2=""!($E(X2,1,$L(X1))'=X1)  Set Y(0)=Y(0)+1,Y(Y(0))=X2_$J("",15-$L(X2))_"| "_$P(^SD("D",X2),"`",2)_D_X2
 If X2=""!($E(X2,1,$L(X1))'=X1) Set X2=-1
 Quit Y(0)
 
INIT    
 Kill Y
 Do INIT^PROC("SDDTL")
 Do RESET^vhScherm,ADD^vhScherm(1,24)
 Quit
REFRESH 
 If sRT<8 Do DISPLAY^vhScherm("SDHFD",1,8,"H")
 If sRT=8 Set FP=801 Write @F,@F2 Do DISPLAY^vhScherm("SDHFD",1,8,"H",9)
 Kill DL Set DL(1)="SDDTL"
 If sRB>8 Set DL(2)=sRT,DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
NIEUW 
 S Scherm=""
 Do NIEUW^vhScherm("SDHFD",2,24,1)
 Quit:'%SC
 S X=Scherm
 Goto EDIT
 
DUPLI Do REFRESH
 Set X=$$ASK^vhINP("Scherm dupliceren naar : ",30,"","Een UNIEKE schermnaam (min. 2 karakters lang)")
 Quit:X="-"
 Goto DUPLI:X'?1A1.E
 Goto DUPLI:$D(^SD("D",X))
 Set X=$$UPCASE^vhRtn1(X)
 Lock +^SD("D",X)
 Do COPYBOOM^vhRtn1("^SD(""D"",Scherm)","^SD(""D"",X)")
 Lock -^SD("D",Scherm)
 Set IsChanged=1
 Do ADD^vhScherm(1,24)
 Set Scherm=X
 Quit
 
GCOPY(Scherm,VOL) 
 Kill ^|VOL|SD("D",Scherm)
 Do COPYBOOM^vhRtn1("^SD(""D"",Scherm)","^|VOL|SD(""D"",Scherm)")
 w *7
 Quit
 
DELETE Do REFRESH
 Set X=$$ASK^vhINP("Bent U zeker dat U wenst te verwijderen : ",1,"","V[] = verwijder")
 Quit:X'="V"
 Kill ^SD("D",Scherm)
 Kill ^SD("L",Scherm)
 Set R="-"
 Do RESET^vhScherm
 Write @F11,@F1
 Quit
 
 
EDIT Lock +^SD("D",Scherm)
 Do INIT,REFRESH
 Set Input=""
 For  Quit:Input="-"  Do
 .Set DL(3)=3
 .Do SL^PROC
 .Set Input=R
 .If Input="HELP" Set R="" Do POP^MN("SD") Set Input=R Do REFRESH
 .If Input="ENTER"!(Input="E") Do LWIJZIG(SDDTL(6))
 .If Input="N" Do LNIEUW()
 .If Input="(" Do LSWAP(SDDTL(6),"UP")
 .If Input=")" Do LSWAP(SDDTL(6),"DO")
 .If Input="V" Do LDELETE(SDDTL(6))
 .If Input="D" Do LDUPLI(SDDTL(6))
 .If Input="I" Do LINSERT
 .If Input="H" Do HOOFDING
 .If Input="S" Do SHOW(Scherm)
 .If Input="C" Do GCOPY(Scherm,"REM-ADMIN1")
 .Do REFRESH
 Set sRef("SD")=Scherm
 Lock -^SD("D",Scherm)
 Quit
HOOFDING 
 Do EDIT^vhScherm("SDHFD",2,24,1)
 Do ADD^vhScherm(2,6)
 Quit
LDELETE(Fld) 
 Do DELETE^PROC3
 Do LDELETE^PROC3(Fld,SDDTL(9)+1,"^SD(""D"",Scherm,""E"",")
 Quit
 
LWIJZIG(Fld) 
 Goto LNIEUW2:'$D(^SD("D",Scherm,"F",Fld))
 Do EDIT^vhScherm("SDDTL"),EL^PROC
 Quit
LDUPLI(Fld) 
 Quit:'$D(^SD("D",Scherm,"F",Fld))
 Do DUPLI^PROC3
 Do LDUPLI^PROC3(Fld,SDDTL(6),"^SD(""D"",Scherm,""E"",")
 Do LWIJZIG(SDDTL(6))
 Do LDELETE(SDDTL(6)):'%SC
 Quit
 
LINSERT Do INSERT^PROC3
 Set Fld=SDDTL(6)
 Do LINSERT^PROC3(Fld,SDDTL(9),"^SD(""D"",Scherm,""E"",")
 Do LNIEUW(Fld)
 Do LDELETE(SDDTL(6)):'%SC
 Quit
LNIEUW(Fld) 
 Set:'$D(Fld) Fld=$O(^SD("D",Scherm,"F",""),-1)+1 ;Volgend vrij nummer
LNIEUW2 Do NIEUW^vhScherm("SDDTL")
 Quit:'%SC
 Do DL^PROC
 Kill SDDTL(7) Set SDDTL(6)=Fld Set:Fld>SDDTL(9) SDDTL(9)=Fld
 Do EL^PROC
 Quit
LSWAP(Fld,Dir) 
 Quit:'$D(^SD("D",Scherm,"F",Fld))
 Do SWAP^PROC3(Dir)
 If Fld'=SDDTL(6) Do LSWAP^PROC3(SDDTL(6),Fld,"^SD(""D"",Scherm,""E"",")
 Quit
 ; **** TONEN VAN HET SCHERM **** 
SHOW(sScrn) 
 New sFR,sScrnRec,sScrnW,sDelim,sYP,sXP,sModT,sDispOnly,sFld,sEdit,sInp,sEditNr,sScrnPos,sEndPos,sFL,sNoTit,sPromptL,sVal,K
 Quit:'$D(^SD("D",sScrn))
 Set sScrnRec=^SD("D",sScrn)
 Set:'$G(sScrnPos) sScrnPos=$P(sScrnRec,"`",1) Set:'sScrnPos sScrnPos=1
 Set sScrnW=$P(sScrnRec,"`",4) Set:'sScrnW sScrnW=80
 Set sDelim=D Set:$L($P(sScrnRec,"`",5)) D=$C($P(sScrnRec,"`",5))
 Set sPromptL=$P(sScrnRec,"`",6) Set:'sPromptL sPromptL=15
 Set:'$G(sEndPos) sEndPos=24
 Set sNoTit=$G(sNoTit)
 Set sScrnPos=sScrnPos-sNoTit
 Set sModT="E"
 Write @F11,@F1
 Do KADER("Titel",$P(sScrnRec,"`",3))
 Set sEdit=""
 For sFld=1:1 Quit:'$D(^SD("D",sScrn,"F",sFld))  Do
 .Set sFR=^(sFld)
 .Set sDispOnly=$P(sFR,"`",12)["D"!(sModT="D")
 .If 'sDispOnly Set sEdit=sEdit+1,sEdit(sEdit)=sFld Do DISPRM(sFld,sFR,sEdit)
 .If sDispOnly Do DISPRM(sFld,sFR)
 .Do DISPVAL(sFld,sFR)
 W @F11 R *K
 s D=sDelim
 Do ADD^vhScherm(1,24)
 Quit
KADER(Titel,Type) 
 S FP=sScrnPos*100+1
 If sEndPos=24 Write @F,@F1
 Else  For FP=sEndPos*100+1:-100:sScrnPos+sNoTit*100+1 Write @F,@F2
 Quit:$G(sNoTit)
 I $L(Titel) Do
 .Write @F,@F7,$TR($J("",sScrnW-$L(Titel)\2-1)," ",$c(113)),@F8
 .Write " "_Titel_" "
 .Write @F7,$TR($J("",sScrnW-(sScrnW-$L(Titel)\2)-1-$L(Titel))," ",$c(113)),@F8
 Else  Write @F,@F7,$TR($J("",sScrnW)," ",$C(113)),@F8
 Quit
DISPRM(sFld,sFR,SEditNr) 
 Set:'$L(sFR) sFR=^SD("D",sScrn,"F",sFld)
 S sXP=$P(sFR,"`",1) S:'sXP sXP=$P(sFR,"`",5)
 S sYP=$P(sFR,"`",2) S:'sYP sYP=$P(sFR,"`",6)-sPromptL
 If $P(sFR,"`",12)["P" Do
 .If $G(sNr) Set FP=sScrnPos+sXP*100+sYP-2+sPromptL-$S($P(sFR,"`",12)[":":3,1:1) Write @F,$J(sEditNr,2)
 If $P(sFR,"`",12)'["P" Do
 .Do WRITE(sXP,sYP,$P(sFR,"`",3),$P(sFR,"`",4))
 .If $G(sEditNr) Set FP=sScrnPos+sXP*100+sYP-3 Write @F,$J(sEditNr,2)
 If $P(sFR,"`",12)[":" Set FP=sScrnPos+$P(sFR,"`",5)*100+$P(sFR,"`",6)-2 W @F,":"
 Quit
 ; Display value
DISPVAL(sFld,sFR) 
 New sFmt
 Set:$P(sFR,"`",10)+$P(sFR,"`",6)>sScrnW $P(sFR,"`",10)=sScrnW-$P(sFR,"`",6)
 Set sFmt=$P(sFR,"`",7,11)
 Set $P(sFmt,"`",1)="sVal",sVal="Tekst"
 Set:"DW;DM;DK;DL;J;T"[$P(sFmt,"`",2) sVal=$H
 Set:$P(sFmt,"`",2)["N" sVal=$E("1234567890",1,$P(sFmt,"`",4)-1-($P(sFmt,"`",2)\3))
 ;Set $P(sFmt,"`",8)=$G(^SD("D",sScrn,"F",sFld,"F"))
 Do WRITE($P(sFR,"`",5),$P(sFR,"`",6),$$FKOL^vhRtn2(sFmt),"I")
 Quit
WRITE(X,Y,Val,Attrib) 
 New sFmtO,sFmtA
 S (sFmtO,sFmtA)=""
 S:Attrib["B" sFmtO=","_FMTB,sFmtA=","_FMTb
 S:Attrib["U" sFmtO=sFmtO_","_FMTU,sFmtA=sFmtA_","_FMTu
 S:Attrib["I" sFmtO=sFmtO_","_FMTI,sFmtA=sFmtA_","_FMTi
 S:Attrib["K" sFmtO=sFmtO_","_FMTK,sFmtA=sFmtA_","_FMTk
 If $L(sFmtO) Set FP=sScrnPos+X*100+Y W @F,@$E(sFmtO,2,99),Val,@$E(sFmtA,2,99)
 Else  Set FP=sScrnPos+X*100+Y W @F,Val
 Quit