PP ;Pop definitie [ 11/07/2001  1:47 PM ]
 S Q="I" D ^cA604,INIT^vhTERMINA
PP1 Set FP=101 Write @F,@F1,@FMTI,"Popup beheer : ",QN,@FMTi
 Set X1=$G(sRef("PP")),%J=$$%J^vhRtn1()
 Kill ^HULP(%J)
PP2 Set X1=$$ASK^vhINP("Popup : ",10,X1,"","De eerste letters van de popupnaam, *[] = Nieuw")
 Quit:X1="-"
 I X1="*" Goto NIEUW
 S (X2,X1)=$$UPTRIMAN^vhRtn1(X1)
 Goto PP2:X1=""
 I $D(^POP(X1)),$E($O(^POP(X1)),1,$L(X1))'=X1 Goto PP3
 Goto PP1:$E($O(^POP(X2)),1,$L(X1))'=X1
 Set Y(0)=0
 If $D(^POP(X1)) S X2=$O(^POP(X1),-1)  ;Y(0)=1,Y(1)=X2_$J("",15-$L(X2))_"| "_$P(^POP(X2),"`",2)_D_X2
 S Y="20\\Select Popup\\FMORE^PP",X=""
 Set Y(0)=$$FMORE(0,5)
 Do ^POP
 If X S X1=$P(Y(X),D,2) Goto PP3
 Goto PP1
PP3 Set PopUp=X1
 Do FETCH
 Goto EDIT
 ;
FMORE(Max,Len,Ref) 
 Quit:X2=-1 Max
 For J=1:1:Len S X2=$O(^POP(X2)) Quit:X2=""!($E(X2,1,$L(X1))'=X1)  Set Y(0)=Y(0)+1,Y(Y(0))=X2_$J("",15-$L(X2))_"| "_$P(^POP(X2),D)_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("PPDTL")
 Do RESET^vhScherm,ADD^vhScherm(1,24)
 Quit
 ;
REFRESH 
 If sRT=1 Write @F11,@F1,@FMTI,"Popup beheer : ",QN,@FMTi
 If sRT<(PPDTL(3)-1) Do DISPLAY^vhScherm("PPHFD",1,6,"H")
 Do REFRESH^PROC(.PPDTL)
 Do RESET^vhScherm
 Quit
 ;
NIEUW 
 S PopUp=""
 Do NIEUW^vhScherm("PPHFD",2,24,1)
 Quit:'%SC
 S X=PopUp
 Goto EDIT
 ;
DUPLI Do REFRESH
 Set X=$$ASK^vhINP("Popup dupliceren naar : ",10,"","Een UNIEKE popupnaam (min. 2 karakters lang)")
 Quit:X="-"
 Goto DUPLI:X'?1A1.E
 Set X=$$UPCASE^vhRtn1(X)
 Goto DUPLI:$D(^POP(X))
 Lock +^POP(X)
 ;Do COPYBOOM^vhRtn1("^POP(PopUp)","^POP(X)")
 Merge ^POP(X)=^POP(PopUp)
 Lock -^POP(PopUp)
 Set PopUp=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 ^HULP(%J)
 Set R="-"
 Do RESET^vhScherm
 Write @F11,@F1
 Quit
 ;
FETCH New R,Key,Count
 Set R=$TR(^POP(PopUp),"\","`"),^HULP(%J)=R,Key=""
 For  Set Key=$O(^POP(PopUp,"D",Key)) Quit:Key=""  Do
 .Set R=$TR(^POP(PopUp,"D",Key),"\","`"),Count=$P(R,"`"),$P(R,"`")=Key,^HULP(%J,Count)=R
 .For I="N","F","D","E" Set R=$G(^POP(PopUp,"D",Key,I)),^HULP(%J,Count,I)=R
 Quit
 ;
SAVE New I,R,Key,Count,Text,TaalAfh,IOIndex,LabPar1,LabPar2,LabPar3,LabPar4
 Kill ^POP(PopUp)
 Quit:'$D(^HULP(%J))
 Set R=$TR(^HULP(%J),"`","\"),^POP(PopUp)=R
 Set TaalAfh=$P(R,"\",2),IOIndex=$P(R,"\",4),LabPar1=$P(R,"\",7)
 Set LabPar2=$P(R,"\",8),LabPar3=$P(R,"\",9),LabPar4=$P(R,"\",10)
 For Count=1:1 Quit:'$D(^HULP(%J,Count))  Do
 .Set R=$TR(^HULP(%J,Count),"`","\")
 .Set Key=$P(R,"\"),Text=$P(R,"\",2),$P(R,"\")=Count
 .For I=1:1:4 If @("LabPar"_I)="" Set $P(R,"\",I+2)=""
 .Set ^POP(PopUp,"D",Key)=R
 .If TaalAfh For I="N","F","D","E" Set R=^HULP(%J,Count,I) If $L(R) Set ^POP(PopUp,"D",Key,I)=R
 .If IOIndex Set ^POP(PopUp,"IO",Text,Key)=""
 Set IsChanged=0
 Quit
 ;
EDIT Lock +^POP(PopUp)
 Do INIT,LDDETAIL,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("PP"),REFRESH
 .Set Input=R
 .If Input="ENTER"!(Input="E") Do LWIJZIG(PPDTL(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 LDUPLI(PPDTL(6))
 .If Input="I" Do INSERT^PROC3,LNIEUW(PPDTL(6)),DELETE^PROC3:'%SC
 .If Input="H" Do HOOFDING
 .Do REFRESH
 .If "H,E,ENTER,N,(,),V,D,I,H"[Input Set IsChanged=1
 Do SAVE
 If $G(sRef("PP"))'=PopUp Set sRef("PP")=PopUp
 Else  Kill sRef("PP") If $D(^POP(PopUp)) Set sRef("PP")=PopUp
 Lock -^POP(PopUp)
 Kill ^HULP(%J)
 Quit
 ;
GCOPY(PopUp,VOL,NoBell) 
 Do:IsChanged SAVE
 Kill ^|VOL|POP(PopUp)
 ;Do COPYBOOM^vhRtn1("^POP(PopUp)","^|VOL|POP(PopUp)")
 Merge ^|VOL|POP(Popup)=^POP(Popup)
 w:'$G(NoBell) *7
 Quit
 
GCOPYA(Vol) 
 Set IsChanged=0,Lijst=""
 For  Set Lijst=$O(^POP(Lijst)) Quit:Lijst=""  Do GCOPY(Lijst,Vol,1)
 W !,"**** Alles gekopieerd van POP ****"
 Quit
 ;
HOOFDING 
 Do EDIT^vhScherm("PPHFD",2,24,1)
 Quit
 ;
LDUPLI(Fld) 
 New Cnt
 Do DUPLI^PROC3
 If $P(^HULP(%J),"`",3) Do  ; Autmatische nummering
 .Set Cnt=$P(^HULP(%J),"`",3)+1,$P(^HULP(%J),"`",3)=Cnt
 .Set $P(^HULP(%J,PPDTL(9)),"`",1)=Cnt
 Do LWIJZIG(PPDTL(6)),DELETE^PROC3:'%SC 
 Quit
 
LWIJZIG(Fld) New R,ScrnPos
 Goto LNIEUW2:'$D(^HULP(%J,Fld))
 Set R=^HULP(%J),ScrnPos=$P(^SD("D","PPDTL"),"`")
 If '$P(R,"`",2) Set ScrnPos=ScrnPos+3 Set:$P(R,"`",9)="" ScrnPos=ScrnPos+1
 Do EDIT^vhScherm("PPDTL",ScrnPos),EL^PROC
 Quit
LNIEUW(Fld) 
 New R,ScrnPos
 Set:'$D(Fld) Fld=$O(^HULP(%J,""),-1)+1 ;Volgend vrij nummer
LNIEUW2 Set R=^HULP(%J),ScrnPos=$P(^SD("D","PPDTL"),"`")
 If '$P(R,"`",2) Set ScrnPos=ScrnPos+3 Set:$P(R,"`",9)="" ScrnPos=ScrnPos+1
 Do NIEUW^vhScherm("PPDTL",ScrnPos)
 Quit:'%SC
 Do DL^PROC
 Kill PPDTL(7) Set PPDTL(6)=Fld Set:PPDTL(9)<Fld PPDTL(9)=Fld
 Do EL^PROC
 Quit
POP(sPopUp,Pos) 
 New Y,X,Titel,Fld,sLD,DL,Titel2,Pos
 W !,sPopUp r r
 Set Titel=$P(^POP(sPopUp),"`",1)
 X:Titel'="" "Set Titel="_Titel
 Set:Titel="" Titel=sPopUp
 Do INIT^PROC("MENU","sLD")
 Set:'$G(Pos) Pos=$P(^POP(sPopUp),"`",2) Set:'Pos Pos=20
 Set Fld="",Y(0)="",X=""
 For  Set Fld=$O(^POP(sPopUp,"D",Fld)) Quit:Fld=""  Do
 .If $P(^(Fld),"`",5)'="" X "S R="_$P(^(Fld),"`",5) Quit:'R
 .Set Y(0)=Y(0)+1
 .Set Y(Y(0))=$P(^POP(sPopUp,"D",Fld),"`",2)_"`"_$P(^(Fld),"`",1)_"`"_$P(^(Fld),"`",3,4)
 Quit:'Y(0)
 Set sLD(9)=Y(0)
 Set sRT=Pos
 If $P(^POP(sPopUp),"`",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  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
 Do WL^PROC
POP2 Do SL^PROC
 If R="HELP",$P(^POP(sPopUp),"`",3) Quit
 If R="-"!(R=",") S R="" Quit
 Goto POP2:R'="ENTER"
 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
M Set sPopUp=$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
 ;
CHECKKEY(Key) 
 New Count
 Quit:Key="" 2
 For Count=1:1 Quit:'$D(^HULP(%J,Count))  If Key=$P(^HULP(%J,Count),"`") Quit
 Quit $T
 ;
FETCHDET 
 Set sFL(1)=$G(^HULP(%J,Fld))
 Set sFL(2)=$G(^HULP(%J,Fld,"N")),sFL(3)=$G(^HULP(%J,Fld,"F"))
 Set sFL(4)=$G(^HULP(%J,Fld,"D")),sFL(5)=$G(^HULP(%J,Fld,"E"))
 Quit
 ;
SAVEDET 
 If $P(sFL(1),"`")="",$P(^HULP(%J),"`",3) Do
 .Set $P(sFL(1),"`")=$P(^HULP(%J),"`",3),$P(^HULP(%J),"`",3)=$P(sFL(1),"`")+1
 Set ^HULP(%J,Fld)=sFL(1)
 Set ^HULP(%J,Fld,"N")=$G(sFL(2)),^HULP(%J,Fld,"F")=$G(sFL(3))
 Set ^HULP(%J,Fld,"D")=$G(sFL(4)),^HULP(%J,Fld,"E")=$G(sFL(5))
 Quit
 ;
ATTRIB 
 New I,R
 Set R=^HULP(%J)
 If '$P(R,"`",2) For I=3:1:6 D PUTATTR^vhScherm(I,"DH","DH")
 For I=7:1:10 If $P(R,"`",I)="" D PUTATTR^vhScherm(I,"DH","DH")
 ; Aanpassen lengte van Key en Omschrijving
 Set $P(sScrnDef(2),"`",14)=OLength
 Set:$P(sScrnDef(2),"`",10)>OLength $P(sScrnDef(2),"`",10)=OLength
 Set $P(sScrnDef(1),"`",14)=KLength
 Set:$P(sScrnDef(1),"`",10)>KLength $P(sScrnDef(1),"`",10)=KLength
 Set OmsLen=$P(R,"`",2)
 If OmsLen For I=3:1:6 Do
 .Set $P(sScrnDef(I),"`",14)=OmsLen
 .Set:$P(sScrnDef(I),"`",10)>OmsLen $P(sScrnDef(I),"`",10)=OmsLen
 Quit
 ;
LDDETAIL 
 New I,R,LabPar1,LabPar2,LabPar3,LabPar4
 Quit:'$D(PPDTL)
 Set R=^HULP(%J),KLength=$P(R,"`",5),OLength=$P(R,"`",6)
 Set:'KLength KLength=1 Set:'OLength OLenght=15
 Set LabPar1=$P(R,"`",7),LabPar2=$P(R,"`",8),LabPar3=$P(R,"`",9),LabPar4=$P(R,"`",10)
 Set PPDTL(2)=$P(PPDTL(2),"\",1,3),PPDTL(8)=$P($P(PPDTL(8),"`"),"|",1,2)
 Set R=$P(PPDTL(2),"\",3),$P(R,";",4)=$S(OLength>40:40,1:OLength),$P(PPDTL(2),"\",3)=R
 Set R=$P(PPDTL(2),"\",2),$P(R,";",4)=KLength,$P(PPDTL(2),"\",2)=R
 Set R=$E("Key",1,KLength),R=R_$J("",KLength-$L(R)),$P(PPDTL(8),"|")=R
 Set R=$E("Omschrijving",1,$S(OLength>40:40,1:OLength)),R=R_$J("",$S(OLength>40:40,1:OLength)-$L(R)),$P(PPDTL(8),"|",2)=R
 For I=1:1:4 Do
 .Quit:@("LabPar"_I)=""
 .Set PPDTL(2)=PPDTL(2)_"\"_(I+2)_";C;L;10;;|;;"
 .Set PPDTL(8)=PPDTL(8)_"|"_@("LabPar"_I)_$J("",10-$L(@("LabPar"_I)))
 For I=2:1 Set R=$P(PPDTL(2),"\",I) Quit:R=""  Do
 .If I=$L(PPDTL(2),"\") Set $P(R,";",6)=""
 .Else  Set $P(R,";",6)="|"
 .Set $P(PPDTL(2),"\",I)=R
 Set PPDTL(8)=PPDTL(8)_"`-1"
 Quit
 ;