LD ;Lijst definitie [ 10/12/2001   4:09 PM ]
 Do INIT^vhTERMINA
LD1 Set FP=101 Write @F,@F1,@FMTI,"Lijst beheer : ",QN,@FMTi
 Set X1=$G(sRef("LD"))
LD2 Set X1=$$ASK^vhINP("Lijst : ",12,X1,"","De eerste letters van de lijstnaam, *[] = Nieuw")
 Quit:X1="-"
 Goto LD2:X1=""
 I X1="*" Goto NIEUW
 S (X2,X1)=$$UPTRIMAN^vhRtn1(X1) I $D(^LD("D",X1)),$E($O(^LD("D",X1)),1,$L(X1))'=X1 Goto LD3
 Goto LD1:$E($O(^LD("D",X2)),1,$L(X1))'=X1
 Set Y(0)=0
 If $D(^LD("D",X1)) S X2=$O(^LD("D",X1),-1)  ;Y(0)=1,Y(1)=X2_$J("",15-$L(X2))_"| "_$P(^LD("D",X2),"`",1)_D_X2
 S Y="20\\Select lijst\\FMORE^LD",X=""
 Set Y(0)=$$FMORE(0,5)
 Do ^POP
 If X S X1=$P(Y(X),D,2) Goto LD3
 Goto LD1
LD3 Set Lijst=X1
 Goto EDIT
 
FMORE(Max,Len,Ref) 
 Quit:X2=-1 Max
 For J=1:1:Len S X2=$O(^LD("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(^LD("D",X2),"`",1)_D_X2
 If X2=""!($E(X2,1,$L(X1))'=X1) Set X2=-1
 Quit Y(0)
 
INIT 
 Do INIT^PROC("LDDTL")
 Do RESET^vhScherm,ADD^vhScherm(1,24)
 Set IsChanged=0
 Quit
REFRESH 
 If sRT<11 Do DISPLAY^vhScherm("LDHFD",1,10,"H")
 Kill DL Set DL(1)="LDDTL"
 If sRB>11 Set:sRT>12 DL(2)=sRT Set:sRB<24 DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
NIEUW 
 S Lijst=""
 Do NIEUW^vhScherm("LDHFD",2,24,1)
 Quit:'%SC
 S X=Lijst
 Goto EDIT
 
DUPLI Do REFRESH
 Set X=$$ASK^vhINP("Lijst dupliceren naar : ",12,"","Een UNIEKE lijstnaam (min. 2 karakters lang)")
 Goto LD1:X="-"
 Goto DUPLI:X'?1A1.E
 Goto DUPLI:$D(^LD("D",X))
 Set X=$$UPCASE^vhRtn1(X)
 Lock +^LD("D",X)
 Do COPYBOOM^vhRtn1("^LD(""D"",Lijst)","^LD(""D"",X)")
 Do COPYBOOM^vhRtn1("^LD(""L"",Lijst)","^LD(""L"",X)")
 Lock -^LD("D",Lijst)
 Set IsChanged=1
 Set Lijst=X
 Do ADD^vhScherm(1,24)
 Quit
GCOPY(Lijst,VOL) 
 D COMPILE
 Kill ^|VOL|LD("L",Lijst)
 Kill ^|VOL|LD("D",Lijst)
 Do COPYBOOM^vhRtn1("^LD(""D"",Lijst)","^|VOL|LD(""D"",Lijst)")
 Do COPYBOOM^vhRtn1("^LD(""L"",Lijst)","^|VOL|LD(""L"",Lijst)")
 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 ^LD("D",Lijst)
 Kill ^LD("L",Lijst)
 Set R="-"
 Do RESET^vhScherm
 Write @F11,@F1
 Quit
 
 
EDIT Lock ^LD("D",Lijst)
 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("LD") Set Input=R Do REFRESH
 .If Input="ENTER"!(Input="E") Do LWIJZIG(LDDTL(6)) Goto EDIT2
 .If Input="N" Do LNIEUW() Goto EDIT2
 .If Input="(" Do SWAP^PROC3("UP"),RESET^vhScherm Goto EDIT2
 .If Input=")" Do SWAP^PROC3("DO"),RESET^vhScherm Goto EDIT2
 .If Input="V" Do DELETE^PROC3,RESET^vhScherm Goto EDIT2
 .If Input="D" Do DUPLI^PROC3,LWIJZIG(LDDTL(6)),DELETE^PROC3:'%SC Goto EDIT2
 .If Input="I" Do INSERT^PROC3,LNIEUW(LDDTL(6)),DELETE^PROC3:'%SC Goto EDIT2
 .If Input="H" Do HOOFDING Goto EDIT2
 .If Input="T" Do TITEL Goto EDIT2
 .Quit
EDIT2 .Set IsChanged=1
 .Do REFRESH
 Do:IsChanged COMPILE
 Set sRef("LD")=Lijst
 Lock -^LD("D",Lijst)
 Quit
COMPILE Set Fld=""
 Set S=""
 For  Set Fld=$O(^LD("D",Lijst,"F",Fld)) Quit:Fld=""  Do
 .Set R=^(Fld),S=S_"\"_$TR($P(R,"`",2,9),"`",";")
 If $L(S),$P(^LD("D",Lijst),"`",2) Set S=$P(^(Lijst),"`",2)_S
 Else  Set S=$E(S,2,999)
 S:$L(S) ^LD("L",Lijst)=S
 Quit
HOOFDING 
 Do EDIT^vhScherm("LDHFD",2,24,1)
 Quit
 
TITEL 
 Do EDIT^vhScherm("LDHEAD")
 Do:%SC ADD^vhScherm(1,24)
 Quit
FORMAT(Lijst) 
 Set Fld=""
 Set S=""
 For  Set Fld=$O(^LD("D",Lijst,"F",Fld)) Quit:Fld=""  Do
 .Set R=^(Fld),$P(R,"`",2)=""""_$P(R,"`",1)_"""",$P(R,"`",3)="C"
 .Set S=S_"\"_$TR($P(R,"`",2,8),"`",";")
 Kill FL
 Set FL(1)=$E(S,2,999)
 Set FL(2)=""
 Do FL^PROC
 Quit R
LWIJZIG(Fld) 
 Goto LNIEUW2:'$D(^LD("D",Lijst,"F",Fld))
 Do EDIT^vhScherm("LDDTL"),EL^PROC
 Quit
LNIEUW(Fld) 
 Set:'$D(Fld) Fld=$O(^LD("D",Lijst,"F",""),-1)+1 ;Volgend vrij nummer
LNIEUW2 Do NIEUW^vhScherm("LDDTL")
 Quit:'%SC
 Do DL^PROC
 Kill LDDTL(7) Set LDDTL(6)=Fld Set:LDDTL(9)<Fld LDDTL(9)=Fld
 Do EL^PROC
 Quit