MN ;Menu definitie [ 08/29/98  9:01 AM ]
 D INIT^vhTERMINA
MN1 Set FP=101 Write @F,@F1,@FMTI,"Menu beheer : ",QN,@FMTi
 Set X1=$G(sRef("MN"))
MN2 Set X1=$$ASK^vhINP("Menu : ",15,X1,"","De eerste letters van de menunaam, *[] = Nieuw")
 Quit:X1="-"
 Goto MN2:X1=""
 I X1="*" Goto NIEUW
 S (X2,X1)=$$UPTRIMAN^vhRtn1(X1) I $D(^MN("D",X1)),$E($O(^MN("D",X1)),1,$L(X1))'=X1 Goto MN3
 Goto MN1:$E($O(^MN("D",X2)),1,$L(X1))'=X1
 Set Y(0)=0
 If $D(^MN("D",X1)) S X2=$O(^MN("D",X1),-1)  ;Y(0)=1,Y(1)=X2_$J("",15-$L(X2))_"| "_$P(^MN("D",X2),"`",2)_D_X2
 S Y="20\\Select Menu\\FMORE^MN",X=""
 Set Y(0)=$$FMORE(0,5)
 Do ^POP
 If X S X1=$P(Y(X),D,2) Goto MN3
 Goto MN1
MN3 Set Menu=X1
 Goto EDIT
 
FMORE(Max,Len,Ref) 
 Quit:X2=-1 Max
 For J=1:1:Len S X2=$O(^MN("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(^MN("D",X2),"`")_D_X2
 If X2=""!($E(X2,1,$L(X1))'=X1) Set X2=-1
 Quit Y(0)
 
INIT 
 Set Niveau=0
 Kill Y
 Do INIT^PROC("MNDTL")
 Do RESET^vhScherm,ADD^vhScherm(1,24)
 Quit
REFRESH 
 If sRT=1 Write @F11,@F1,@FMTI,"Menu beheer : ",QN,@FMTi
 If sRT<5 Do DISPLAY^vhScherm("MNHFD",2,4,1)
 Kill DL Set DL(1)="MNDTL"
 If sRB>4 Set:sRT>5 DL(2)=sRT Set:sRB<24 DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
NIEUW 
 S Menu=""
 Do NIEUW^vhScherm("MNHFD",2,24,1)
 Quit:'%SC
 S X=Menu
 Goto EDIT
 
DUPLI Do REFRESH
 Set X=$$ASK^vhINP("Menu dupliceren naar : ",15,"","Een UNIEKE menunaam (min. 2 karakters lang)")
 Quit:X="-"
 Goto DUPLI:X'?1A1.E
 Goto DUPLI:$D(^MN("D",X))
 Set X=$$UPCASE^vhRtn1(X)
 Lock +^MN("D",X)
 Do COPYBOOM^vhRtn1("^MN(""D"",Menu)","^MN(""D"",X)")
 Lock -^MN("D",Menu)
 Set Menu=X
 Do ADD^vhScherm(1,24)
 Quit
 
DELETE Do REFRESH
 Set X=$$ASK^vhINP("Bent U zeker dat U wenst te verwijderen : ",1,"","V[] = Verwijder")
 Quit:X'="V"
 Kill ^MN("D",Menu)
 Kill ^MN("L",Menu)
 Set R="-"
 Do RESET^vhScherm
 Write @F11,@F1
 Quit
 
 
EDIT Lock +^MN("D",Menu)
 Do INIT,REFRESH
 Set Input=""
 Set IsChanged=0
 For  Quit:Input="-"  Do
 .Set DL(3)=3
 .Do SL^PROC
 .If R="HELP" Set R="" Do POP^MN("MN"),REFRESH
 .Set Input=R
 .If Input="ENTER"!(Input="E") Do LWIJZIG(MNDTL(6))
 .If Input="N" Do LNIEUW()
 .If Input="(" Do SWAP^PROC3("UP")
 .If Input=")" Do SWAP^PROC3("DO")
 .If Input="V" Do DELETE^PROC3
 .If Input="D" Do DUPLI^PROC3,LWIJZIG(MNDTL(6)),DELETE^PROC3:'%SC
 .If Input="I" Do INSERT^PROC3,LNIEUW(MNDTL(6)),DELETE^PROC3:'%SC
 .If Input="H" Do HOOFDING
 .Do REFRESH
 .If "H,E,ENTER,N,(,),V,D,I,H"[Input Set IsChanged=1
 Set sRef("MN")=Menu
 Lock -^MN("D",Menu)
 Quit
 
GCOPY(Menu,VOL) 
 Kill ^|VOL|MN("D",Menu)
 Do COPYBOOM^vhRtn1("^MN(""D"",Menu)","^|VOL|MN(""D"",Menu)")
 w *7
 Quit
 
HOOFDING 
 Do EDIT^vhScherm("MNHFD",2,24,1)
 Do DISPLAY^vhScherm("MNHFD",2,6,1)
 Quit
 
LWIJZIG(Fld) 
 Goto LNIEUW2:'$D(^MN("D",Menu,"F",Fld))
 Do EDIT^vhScherm("MNDTL"),EL^PROC
 Quit
LNIEUW(Fld) 
 Set:'$D(Fld) Fld=$O(^MN("D",Menu,"F",""),-1)+1 ;Volgend vrij nummer
LNIEUW2 Do NIEUW^vhScherm("MNDTL")
 Quit:'%SC
 Do DL^PROC
 Kill MNDTL(7) Set MNDTL(6)=Fld Set:MNDTL(9)<Fld MNDTL(9)=Fld
 Do EL^PROC
 Quit
POP(sMenu,Pos,sTaal,sAutoSel) 
 New Y,X,Titel,sLD,DL,Titel2
 Set Titel=$P(^MN("D",sMenu),"`",1)
 X:Titel'="" "Set Titel="_Titel
 Set:Titel="" Titel=sMenu
 Do INIT^PROC("MENU","sLD")
 Set:'$G(Pos) Pos=$P(^MN("D",sMenu),"`",2) Set:'Pos Pos=20
 Do FETCH(sMenu,$G(sTaal))
 Quit:'Y(0)
 Set sLD(9)=Y(0)
 Set sRT=Pos
 If $P(^MN("D",sMenu),"`",3) Do
 .Set Titel2=$J("",$L(Titel))_" (Druk HELP voor lijst met topics)"
 .Set Titel=Titel_" (Druk ENTER om een opdracht uit te voeren)"
 .Set FP=Pos*100+1 Write @F,@FMTI,Titel,$J("",80-$L(Titel)),@FMTi
 .Set Titel=Titel2,Pos=Pos+1
 Else  If $L($G(sTaal)),$D(^LD("L","MENU","H",sTaal)) Set Titel=^LD("L","MENU","H",sTaal)
 Else  Set Titel=Titel_" (Druk ENTER om een opdracht uit te voeren)"
 Set sLD(3)=Pos+1
 Kill sLD(4)
 Set sRB=24
 Set sLD(8)=Titel
 If $G(sAutoSel),Y(0)=1 Set R="ENTER" Goto POP3
 Do WL^PROC
POP2 Do SL^PROC
POP3 If R="HELP",$P(^MN("D",sMenu),"`",3) Quit
 If R="-"!(R=",") S R="" Quit
 If R'="ENTER" Do  Goto POP2:'X
 .Set X=0
 .For  Set X=$O(Y(X)) Quit:'X  If $P(Y(X),"`")=R Set sLD(6)=X Quit
 Set X=sLD(6)
 Goto:$P(Y(X),"`",2)="" POP2
 S Op=$P(Y(X),"`",3)
 S R=""
 Goto:$L(Op) @Op:"M,K,D,G,X,B"[Op
 W *7
 Quit
FETCH(sMenu,sTaal) 
 New Fld,X,R
 Set Fld="",Y(0)="",X=""
 For  Set Fld=$O(^MN("D",sMenu,"F",Fld)) Quit:Fld=""  Do
 .If $P(^(Fld),"`",5)'="" X "S R="_$P(^(Fld),"`",5) Quit:'R
 .Set R=^MN("D",sMenu,"F",Fld)
 .If $L($P(R,"`")),"$"""[$E($P(R,"`")) Xecute "Set $P(R,""`"")="_$P(R,"`")
 .Set Y(0)=Y(0)+1
 .Set Y(Y(0))=$P(R,"`",2)_"`"_$P(R,"`",1)_"`"_$P(R,"`",3,4)
 Quit
M Set sMenu=$P(Y(X),"`",4) Goto POP2
K Set R=$P(Y(X),"`",4) Quit
D Do @$P(Y(X),"`",4) Quit
G G @$P(Y(X),"`",4) 
X X @$P(Y(X),"`",4) Quit
B Quit