vhMenu ;Menu routines [ 11/29/2003  1:49 PM ]
 ; **** ENABLE DISABLE VAN MENUS **** 
 
SETL(M1,M2,M3,M4,M5,M6,M7,M8,M9,M10) ;Definieren van menus met de resp. menukeys
 New J,MNNm,List
 For J=1:1:10 Quit:'$D(@("M"_J))  Set MNNm=$P(@("M"_J),"\",1),List=$P(@("M"_J),"\",2) Do SET1
 Quit
 
SET(MNNm,List) ; Definieren van een menu met de menukeys
SET1 Kill sS("M",MNNm)
 Set sS("M",MNNm)=";"_List_";"
 Quit
 
ENABLE(MNNm,List) ; Bijvoegen van menukeys bij een menu
          ; Of enablen van een menu
 New R,S,T
 Quit:'$D(sS("M"))  Quit:'$D(sS("M",MNNm))
 If '$D(List) S $P(sS("M",MNNm),";",1)="" Quit
 Do DISABLE2
 For R=1:1:$L(List,";") Set S=S_$P(List,";",R)_";"
 Set sS("M",MNNm)=S
 Quit
 
DISABLE(MNNm,List) ; Weghalen van menukeys bij een menu
           ; of disablen van een menu
 New R,S,T
 Quit:'$D(sS("M"))  Quit:'$D(sS("M",MNNm))
 If '$D(List) S $P(sS("M",MNNm),";",1)=1 Quit
DISABLE2 Set S=sS("M",MNNm)
 For R=1:1:$L(List,";") Do
 .Set T=";"_$P($P(List,";",R),"*",1)_";" Set:S[T S=$P(S,T,1)_";"_$P(S,T,2)
 .Set T=";"_$P($P(List,";",R),"*",1)_"*;" Set:S[T S=$P(S,T,1)_";"_$P(S,T,2)
 Set sS("M",MNNm)=S
 Quit
 
REMOVE(MNNm) ; Verwijderen van een menu
 Kill sS("M",MNNm)
 Quit
 
CHECK(MNNm,Key) 
 If $D(Key) Quit $G(sS("M",MNNm))[(";"_Key_";")
 Else  Quit +$G(sS("M",MNNm))
 
EXIST(sMenu,sMenuI) ;Nakijken of een menuitem in een menu zichtbaar is
 New Y,Z,P,J,XX,R,S,C,%TC
 Do YVAL(2,sMenu)
 Quit:'$G(Y(0)) 0
 F Y=1:1:Y(0) Set %TC=Y(Y)=sMenuI Quit:%TC
 Quit %TC
 
 ; **** OPROEP VAN MENUS EN MENUBARS ****
 
HOOFD ; Tonen van het HOOFD menubar
 New Mn,Sel 
HOOFD2 Set Mn="HOOFD",Sel="" 
 Do CHECK^ML
 Goto C1
 
DETAIL ; Tonen van de DETAIL menubar
 New Mn,Sel
DETAIL2 Set Mn="DETAIL",Sel="" 
 Goto C1
 
CALLSPEC(sPos,Mn,Sel) 
 New MNNm,Y,XX,Z,R,S,P,J,sMNMode
 Set sMNMode="S"
 Do YVAL(2,Mn)
 Set XX=$G(Sel)
 Quit:Y=""
 Write @FMTCL
 Do SPEC^vhMenuPop
 Goto EXECUTE
 
CALL(Mn,Sel)  ; Tonen van een menubar
C1 New MNNm,Y,XX,Z,R,S,P,J,sMNMode ;New voor de verdere verwerking zie YVAL en ^vhMenuPop
C2 ;Quit:Mn'="HOOFD"&(Mn'="DETAIL")
 ;If $L(sC) Quit:+$G(sS("M",Mn))
 Set sMNMode="B"
 Do YVAL(1,Mn)
 Set XX=$G(Sel)
 Quit:Y=""
 Do ^vhMenuPop
 Goto EXECUTE
 
COMMAND(sMenu,sKey) ;Executie van een opdracht in een bepaalde menu           
COM2 New Y,Z,P,J,XX,R,S,C,sMNMode
 Set sMNMode="C"
COM3 Do YVAL(2,sMenu)
 Quit:'$G(Y(0))
 Set C=$$UPCASE^vhRtn1($E(sKey,1))
 Set Y(Y(0)+1)=C
 For J=1:1:Y(0)+1 Set P=$F(Y(J),"$") If Y(J)'["*" Quit:$$UPCASE^vhRtn1($E(Y(J),$S(P:P,1:1)))=C
 If J>Y(0) Set sKey="" Quit
 Set (sKey,XX)=J
 Goto EXECUTE
 
COMDTL(Excl,sKey) ; Executie van een opdracht in de menus van de DETAIL menubar
 New Y,Z,sLX,ZI,J,XX,R,S,C,M,sMenu,sMNMode
 Set sMNMode="C"
 Set sLX=sKey,sKey=""
 Set Excl=";"_Excl_";"
 Do YVAL(1,"DETAIL")
 For M=1:1:Y(0) Quit:sKey'=""  Do
 .New Y
 .Set sMenu=$P(Z(1,M),"`",4)
 .Quit:Excl[(";"_sMenu_";")
 .Set sKey=sLX
 .Kill Z(2)
 .Do COM3
 Quit
 
KEY(sKeyNr) ; Aktiveren van een menuitem in de KEY menu 
    ; Werkt samen met de functietoetsen
 New sMenu,sKey
 Set sMenu=$P($G(sS("M","KEY")),";",sKeyNr+1)
 Quit:sMenu=""
 Set sKey=$P(sMenu,":",2),sMenu=$P(sMenu,":",1)
 Goto COM2
 
 ; **** INTERN Menu ****
 
FETCH ; Ophalen van een menu of menubar, wordt steeds opgeroepen vanuit MenuPop
 New R,P
 Set R=Z(1,XX),P=$P(R,"`",3)
 Set MNNm=$P(R,"`",4)
 ;Set sRCH=$P(Y,"\",2)_"\"_$P(Y,"\",1)
 Do @$S(P="B":"YVAL(1,MNNm)",P="M":"YVAL(2,MNNm)",1:"ERR")
 Quit
 
YVAL(ZI,MNNm) ; Opbouw van de Y en Z local 
 New S
 Kill Y,Z(ZI)
 Set (Y,XX)=""
 ;Goto YDtl:MNNm="DETAIL"
 Quit:'$D(^MN("D",MNNm))
 Set Y="\HBRELY"_$S(ZI=1:"M",1:"")_"\\\"
 Set S=0,Y(0)="*"
 Do FETCHMN(MNNm)
 Quit
 
FETCHMN(MNNm) 
 ;Ophalen van een menu uit de MN global
 ;en deze plaatsen in Y en Z local
 New MKey,POINT,GRP,USR,Max,Init,MR,IR,J,P,R,M,IKey,IsMac,EnableVoorwaarde
 Quit:'$D(^MN("D",MNNm))
 Set IsMac=$P($G(^cLOG("DEV",$I)),D,1)="MC"
 Set P=$O(^MN("D",MNNm,"F","")) Q:P=""
 Set MKey="",Max=1,Init=1
 Set:'+$G(sS("M",MNNm)) MKey=$G(sS("M",MNNm))
 Set EnableVoorwaarde = $Piece($Get(^MN("D",MNNm,"Enabled"),"1"),"`")
 If @("'("_EnableVoorwaarde_")")
 {
	 Set S = S + 1
	 Set Z(ZI,S) = "``G"
	 If ($Length($Piece(^MN("D",MNNm,"Enabled"),"`",2)))
	 {	
	 	Set Y(S) = $Piece(^MN("D",MNNm,"Enabled"),"`",2)
	 }
	 Else
	 {
		 Set Y(S) = "Menu niet beschikbaar"
	 }
	 goto L2
 }
L1 Set R=^MN("D",MNNm,"F",P)
 If $P(R,"`",1)="*",$P(Y(S),"`")="*" Goto L11 ; Verhinderen twee disabelde lijnen achter elkaar
 If $P(R,"`",1)="&S",$P(Y(S),"`")="&S" Goto L11 ; Verhinderen twee separator lijnen achter elkaar
 If $P(R,"`",1)="&S",'S Goto L11 ; Verhinderen separator lijn als eerste
 If $P(R,"`",8),sScr("VTW") Goto L11 ; Niet voor VTW's
 ; Nakijken of keyword in de lijst aanwezig is
 Set M=$P(R,"`",6)
 If M'="",MKey[(";"_M_";")!(MKey[(";"_M_"*;"))
 Else  Goto:M'="" L11
 ;Include test uitvoeren
 Try {
	If $P(R,"`",5)'="",@$TR($P(R,"`",5),"~","\") 
 	Else  Goto:$P(R,"`",5)'="" L11
 } Catch {
	#Dim Exception As TECH.IException = ##class(TECH.ExceptionHandler).Catch()
	Do Exception.VoegToeExtraInfo("Menuitem wordt overgeslagen, want evaluatie van een voorwaarde is gecrasht. R={"_R_"}; MNNm={"_MNNm_"}")
	Do ##class(vhLib.Logger).%New().LogExceptie(Exception)
	Goto L11
 }
 If "F"=$P(R,"`",3) Do FLEX Goto L11
 ; Include submenu
 If ZI=2,"M"=$P(R,"`",3) Do FETCHMN($P(R,"`",4)) Goto L11
 If $P(R,"`",1)["@" Do TRANS
 If $E($P(R,"`"),1,2)="$$" Xecute "Set $P(R,""`"")="_$P(R,"`")
 If $E($P(R,"`"),1,2)="##" Xecute "Set $P(R,""`"")="_$P(R,"`")
 Set IKey=$P(R,"`",2)
 Set S=S+1
 Set Y(S)=$P(R,"`",1)_$S(MKey[(";"_M_"*;"):"*",1:"")_"`"_IKey,Z(ZI,S)=Max_"`"_Init_"`"_$P(R,"`",3,4),$P(Z(ZI,S),"`",7,8)=MNNm_"`"_P
L11 Set P=$O(^MN("D",MNNm,"F",P)) Goto L1:P'=""
L2 If S>0,$P(Y(S),"`")="*" Kill Y(S) Set S=S-1
 If S>0,$P(Y(S),"`")="&S" Kill Y(S) Set S=S-1 ; Verhinderen separator lijn als laatste
 Set Y(0)=S
 If S'>0 Kill Y Set Y=""
 Quit
  
TRANS ;Vertaling van een objectreferentie @Obj@n in tekst van een menuitem
 New P,T,S,O 
 Set T=$P(R,"`",1)
 For  Quit:T'["@"  Do
 .Set O=$P(T,"@",2),P=$E($P(T,"@",3))
 .Set S=@O
 .;Set S=$$GET^Ref(O) Goto TR2:S=""
 .;Set S=$$FETCH^FRef(O,S)
 .;Set S=$P(S,"\",P)
 .Set:S?6N S=$E(S,1,3)_"."_$E(S,4,6)
TR2 .Set T=$P(T,"@")_S_$E($P(T,"@",3,99),2,80)
 Set $P(R,"`",1)=T
 Quit
 
FLEX ; Verwerking van een flexibele menu
 New sM,sQ,sR
 Set sQ=S+1,sR=Max_"`"_Init_"`"_$P(R,"`",3,5),$P(sR,"`",7,8)=MNNm_"`"_P
 Do @$P($P(R,"`",4),";",1) ; Execute routine
 ;Quit:'$D(Y(sQ))
 For sM=sQ:1:S Set:'$D(Z(ZI,sM)) Z(ZI,sM)=sR
 Quit
 
YDtl ; Opbouw van DETAIL menubar in de Y en Z local
 Quit:'$D(sS("M"))
 Set Y="\MY\\DETAIL\\"
 Set Y(0)=0
 If $D(sS("M","DETAIL")) Do
 .Set P=sS("M","DETAIL")
 .For J=2:1:($L(P,";")-1) Set S=$P(P,";",J) If S'="" Set:'+$G(sS("M",S)) Y(0)=Y(0)+1,Y(Y(0))=$P(^MN("D",S),"\",2),Z(ZI,Y(0))="1`1`M`"_S
 Else  Do
 .S P=$O(sS("M",""))
 .For  Quit:P=""  Set:";KEY;FILE;LIST;DETAIL;HOOFD;PRINT;"'[(";"_P_";")&('+sS("M",P)) Y(0)=Y(0)+1,Y(Y(0))=$P(^MN("D",P),"\",2),Z(ZI,Y(0))="1`1`M`"_P Set P=$O(sS("M",P))
 If $D(sS("M","LIST")),'+sS("M","LIST") Set Y(0)=Y(0)+1,Y(Y(0))="List",Z(ZI,Y(0))="1`1`M`LIST"
 If $D(sS("M","FILE")),'+sS("M","FILE") Set Y(0)=Y(0)+1,Y(Y(0))="File",Z(ZI,Y(0))="1`1`M`FILE"
 If $D(sS("M","PRINT")),'+sS("M","PRINT") Set Y(0)=Y(0)+1,Y(Y(0))="Print",Z(ZI,Y(0))="1`1`M`PRINT"
 
 If Y(0)=0 Kill Y S Y=""
 Quit
 
EXECUTE ; Uitvoeren van de geselekteerde menuitem of ingedrukte functietoets
 ;Formaat menuitem selectie : XX = Itemnumber
 ;Formaat functietoets : XX = FunctieKey\IsMenubar\Itemnumber
 Quit:XX=""
 Goto FUNCTIE:XX["\"
 Set R=Z(2,XX),P=$P(R,"`",3) ;,sRCH=$P(R,"`",2)_"\"_$P(R,"`",1)
 Kill Z,Y
 Goto:"GXDSFKM"[P @("L"_P)
ERR Write *7 Set Y="" Quit
 ;Goto
LG Quit
 ;Key
LK Set Input=$P(R,"`",4) Quit
 ;Menu
LM Set MNNm=$P(R,"`",4) Quit  ;Goto L0
 ;eXecute
LX X $P(R,"`",4) Quit
 ;Do
LD Do @$P(R,"`",4) Quit
 ;Scherm
LS Set sS(sN,"R")=$P(sRCH,"\",1)_"\"_sRCH
 Set sS(sN,"A")=$P(R,"`",4)
 Set:$P(R,"`",5)'="" sS(sN,"P")=$P(R,"`",5)
 Goto NEXT^App
 ;Flexibel
LF S Z(2,0)="Z" For P=XX-1:-1:0 Quit:Z(2,XX)'=Z(2,P)
 S R=$P($P(R,"`",4),";",2)
 Do @($P(R,"(",1)_"(XX-P,Y(XX)"_$S($L($P(R,"(",2))>1:","_$P(R,"(",2),1:")"))
 Quit
 
FUNCTIE ; Uitvoeren van de Functietoets 
 ;Formaat XX = "FunctieKey\IsMenubar\Itemnumber"
 Quit:'$L($G(sScr("CVL")))
 Set XX=$P(XX,"\")_U
 Set Input=$P($P(sScr("CVL"),XX,2),"\",1)
 Quit
 
EXEC(MNNm,Trig) 
 ;Ophalen van een menu uit de MN global
 ;en deze plaatsen in Y en Z local
 New MKey,P,R,M,sMNMode
 Set sMNMode="E"
 Quit:'$D(^MN("D",MNNm))
 Set P=$O(^MN("D",MNNm,"F","")) Q:P=""
 Set MKey=""
 Set:'+$G(sS("M",MNNm)) MKey=$G(sS("M",MNNm))

 For P=1:1:$O(^MN("D",MNNm,"F",""),-1){ 
 	 Quit:Trig=""
	 Set R=^MN("D",MNNm,"F",P)
	 Continue:$P(R,"`",1)["*"  ; Disabled
	 Continue:$P(R,"`",1)="&S"  ; Separator
	 If $P(R,"`",8),sScr("VTW") Continue  ; Niet voor VTW's
	 ; Nakijken of keyword in de lijst aanwezig is
	 Set M=$P(R,"`",6)
	 If M'="",MKey[(";"_M_";")!(MKey[(";"_M_"*;"))
	 Else  Continue:M'=""
	 ;Include test uitvoeren
	 Try {
	 	If $P(R,"`",5)'="",@$TR($P(R,"`",5),"~","\") 
	 	Else  Continue:$P(R,"`",5)'=""
	 } Catch {
		#Dim Exception As TECH.IException = ##class(TECH.ExceptionHandler).Catch()
		Do Exception.VoegToeExtraInfo("Menuitem wordt overgeslagen, want evaluatie van een voorwaarde is gecrasht. R={"_R_"}; MNNm={"_MNNm_"}")
		Do ##class(vhLib.Logger).%New().LogExceptie(Exception)
		Continue
	 }
	 ; Include submenu
	 If $P(R,"`",3)="M" Do EXEC($P(R,"`",4),.Trig) Continue
	 Continue:";"_$P(R,"`",7)_";"'[(";"_Trig_";")  ; ExecTrigger
	 Set Trig=""
	 Goto:"GXDSFKM"[$P(R,"`",3) @("L"_$P(R,"`",3))
	 
 }
 Quit
 
Prompt(Prompt)
 Xecute "Set Prompt="_Prompt
 Quit Prompt