POP ;Tonen van een voudige lijsten          [ 10/24/2001  1:28 PM ]
 ; Formaat Y : "Row\Params\Titel\CBSel\CBMore\LijstDef\Keys"
 ;  Row : Begin scherm lijn tot bodem scherm
 ;  Params : M=multiple select
 ;         : V=Volgorde is betekenisvol
 ;         : B=Beginlijn niet veranderlijk
 ;         : F=Selectie door middel van eerste karakter
 ;         : K=Key in edit veld en lijst
 ;         : O=Omschrijving in edit veld (is steeds in lijst)
 ;         : ;=keys gescheiden door ';'
 ;         : G=Geen selectie (dmv SPACE) is NIET toegelaten
 ;  Titel : vrije tekst
 ;  CallbackSelect : Set X=Selectie in lijst X Callback
 ;  CallbackMore : X Callback
 ;  LijstDefintie: Te gebruiken lijstdef : Do INIT^PROC3(LijstDef,sLD)
 ;  Return Keys: Toegelaten keys om terug te keren
 ; Y(0)=Aantal Y-items
 ; Y(i)=Item, alleen het eerste $P(Y(i),"\") wordt getoond
 ;
 ; On exit wordt X gelijkgezet aan de selectielijst, Deze selectie lijst zijn de numerieke entries in Y, gescheiden door een ";"
 
 New DL,sLD,Cnt,R,I,Z,FL,CUR
 If $P(Y,"\",6)="" Do 
 .Set sLD(1)="Y"
 .Set sLD(2)="1;C;L;77"
 .Set sLD(3)=$S($P(Y,"\",2)["B":+Y,25-Y>Y(0):25-Y(0),1:+Y)
 .Set sLD(6)=1
 .Set sLD(8)=$P(Y,"\",3)
 .Set sLD(9)=Y(0)
 Else  Do
 .Do INIT^PROC($P(Y,"\",6),"sLD")
 .Set:$P(sLD(2),"\")?1.3N sLD(2)=$P(sLD(2),"\",2,99)
 .If $P(Y,"\",2)'["B",25-sLD(3)>Y(0) Set sLD(3)=25-Y(0) Kill sLD(4)
 .Set sLD(9)=Y(0)
 .Set sLD(8)=$P(Y,"\",3)
 .Kill sLD(11)
 Set Cnt=0 Set:$L($G(X)) Cnt=$L(X,";")
 If Cnt,$P(Y,"\",2)["M" For I=1:1:Cnt Set:$P(X,";",I) $P(Y($P(X,";",I)),"\",99)=$S($P(Y,"\",2)["V":I,1:"*")
 If Cnt,$P(Y,"\",2)'["M" Set sLD(6)=+X
 Set:$P(Y,"\",2)["M"!($P(Y,"\",2)["V") sLD(2)="99;C;L;2;; \"_sLD(2)
 Kill DL Set DL(1)="sLD"
 Do WL^PROC,ADD^vhScherm(sLD(3)-1,24)
 
P2 Kill IK Do CVL^PROC Set IK(1)=R Do IK^PROC1
 If 'sLD(9) Set X="-" Quit
 If R'="",$P(Y,D,7)[R Set X=R Quit
 If $P(Y,"\",2)["F",R?1A!(R?1N&($P(Y,"\",2)'["V")) Do  I R="",$P(Y,"\",2)'["M" S X=sLD(6) Quit
 .For Cnt=1:1:Y(0) I $E(Y(Cnt))=R  Set R="" Quit
 .If R="" Set sLD(6)=Cnt If $P(Y,"\",2)["M" Kill sLD(7) Do WL^PROC Set R="ENTER"
 If "DO,NP"[R,$P(Y,"\",5)'="",sLD(6)'<(sLD(9)-sLD(4)) Xecute "S Y(0)=$$"_$P(Y,"\",5)_"(Y(0),sLD(4),Y(Y(0)))" Set:sLD(9)=Y(0) $P(Y,"\",5)="" Set sLD(9)=Y(0)
 If "DO,UP,PP,NP,HO"_$S($P(Y,"\",5)="":",EN",1:"")[R Set DL(2)=R Do ML^PROC
 If R="ENTER"!(R=" "),$P(Y,"\",2)'["M" S X=sLD(6) Quit
 If $P(Y,"\",2)["G",R=" " Goto P2
 If R="HELP",$P(Y,"\",2)["H" S X="HELP" Quit
 If R=" "!($P(Y,"\",2)["V"&(R?1.N)&'$P(Y(sLD(6)),"\",99)) Do 
 .Do @$S($P(Y(sLD(6)),"\",99)="":"POPSET",1:"POPRESET")
 .Set (Z,X)="" If $P(Y,"\",4)'="" Do POPVAL Set CUR=sLD(6),Z=X Do @$P(Y,"\",4) ; Callback
 .If Z'="",X="" Do @$S($P(Y(sLD(6)),"\",99)="":"POPSET",1:"POPRESET") ;Ongeldige dmv Callback
 .If Z=""!(X'="") Set DL(2)="DO" Do ML^PROC Kill DL(2)
 If R="-"!(R=".") Set X=R Quit
 If $P(Y,"\",2)'["M",R=" " Set X="" Quit
 If R="ENTER" Do POPVAL Quit
 Goto P2
POPSET If $P(Y,"\",2)'["V" Set $P(Y(sLD(6)),"\",99)="*"
 Else  Do  ;Verplaatsen van eventuele markering
 .New PS,P
 .Set PS=sLD(6),Cnt=Cnt+1
 .Set P=$S(R=" ":Cnt,R>Cnt:Cnt,1:R)
 .I P<Cnt For I=1:1:Y(0) If $P(Y(I),"\",99)'<P Set $P(Y(I),"\",99)=$P(Y(I),"\",99)+1,sLD(6)=I Do DL^PROC
 .Set sLD(6)=PS
 .Set $P(Y(sLD(6)),"\",99)=P
 Do EL^PROC
 Quit
POPRESET If $P(Y,"\",2)["V" Do  ;Verwijderen van een selectie met eventueel het hernummeren
 .New PS,P
 .Set P=$P(Y(sLD(6)),"\",99),PS=sLD(6),Cnt=Cnt-1
 .For I=1:1:Y(0) If $P(Y(I),"\",99)>P Set $P(Y(I),"\",99)=$P(Y(I),"\",99)-1,sLD(6)=I Do DL^PROC
 .Set sLD(6)=PS
 Set $P(Y(sLD(6)),"\",99)=""
 Do EL^PROC
 Quit
POPVAL New Z
 S X=""
 If $P(Y,"\",2)'["V" For I=1:1:Y(0) Set:$P(Y(I),"\",99)'="" X=X_";"_I
 Else  Do
 .For I=1:1:Y(0) Set:$P(Y(I),"\",99)'="" Z($P(Y(I),"\",99))=I
 .For I=1:1:Cnt Set X=X_";"_Z(I)
 Set X=$E(X,2,99)
 Quit  
DISABLE(Lijn) 
 Set sLD(6)=Lijn
 Do POPRESET
 Do DL^PROC
 Set sLD(6)=CUR
 Quit
ENABLE(Lijn) 
 Set sLD(6)=Lijn
 Do POPSET
 Do DL^PROC
 Set sLD(6)=CUR
 Quit
LOOKUP(Global,Val,Pos,Titel) 
 If $E(Global,$L(Global))=")" Set $E(Global,$L(Global))=",Key)"
 Else  Set Global=Global_"(Key)"
 Set Val=$$UPTRIMAN^vhRtn1(Val)
LKP2 Set Key=Val
 If $L(Key),$D(@Global) Quit Key ; Ingave bestaat
 Set Y(0)=0
 For  Set Key=$O(@Global) Quit:Key=""!($E(Key,1,$L(Val))'=Val)  Set Y(0)=Y(0)+1,Y(Y(0))=Key_$J("",5-$L(Key))_" | "_$G(^(Key,"N"))_"\"_Key
 If 'Y(0) Set Titel="Foutieve ingave ("_Val_"), kies "_Titel,Val="" Goto LKP2
 Set Y=Pos+1_"\B\"_Titel,X=""
 Do POP
 Quit:'X ""  
 Quit $P(Y(X),"\",2)
 
LIST(List,Val,Pos,Titel,Format,DisplE,ValE,PutE) 
 New Y,Key,Cnt,Elem,Ret,Z
 Set Y=Pos+1_"\"_$G(Format)_"\"_Titel
 If Format["Q" Do 
 .Set Key=""
 .Set Len=$P(^POP(List),"\",5)
 .For  Set Key=$O(^POP(List,"D",Key)) Quit:Key=""  Set Y($P(^(Key),"\",1))=$S(Format["K":$E(Key,1,Len)_$J("",Len-$L(Key))_" | ",1:"")_$P(^(Key),"\",2)_"\"_Key,Z(Key)=$P(^(Key),"\",1)
 If Format["P" Do 
 .Set Key=""
 .For  Set Key=$O(^POP("I",List,Key)) Quit:Key=""  Set Y(Key)=$S(Format["K":$P(^(Key),"\",1)_" | ",1:"")_$P(^(Key),"\",2)_"\"_$P(^(Key),"\",1),Z($P(^(Key),"\",1))=Key
 If Format'["P",Format'["W",Format'["Q" Do  ; String
 .For Key=1:1:$L(List,"\") Set Elem=$P(List,"\",Key) Set:$L(Elem) Y(Key)=$S(Format["K":$P(Elem,";",1)_" | ",1:"")_$P(Elem,";",2)_"\"_$P(Elem,";",1),Z($P(Elem,";",1))=Key
 If Format["W" Do 
 .Set Key="",Cnt=0,X=""
 .For  X List Quit:Key=""  S Cnt=Cnt+1,Y(Cnt)=$S(Format["K":$P(X,"\",1)_" | ",1:"")_$P(X,"\",2)_"\"_$P(X,"\",1),Z($P(X,"\",1))=Cnt
 Set Y(0)=$O(Y(""),-1),X=""
 If Format[";" For Key=1:1:$L(Val,";") If $L($P(Val,";",Key)) Set:$D(Z($P(Val,";",Key))) X=X_";"_Z($P(Val,";",Key))
 If Format'[";" For Key=1:1:$L(Val) Set:$D(Z($E(Val,Key))) X=X_";"_Z($E(Val,Key))
 Set $E(X)=""
 Do POP
 Set Ret=""
 If X For Cnt=1:1:$L(X,";") Set:$P(X,";",Cnt) Ret=Ret_";"_$P(Y($P(X,";",Cnt)),"\",2)
 Set:Format'[";" Ret=";"_$TR(Ret,";","")
 Set X=$E(Ret,2,99)
 Quit
DISPL(List,Val,Format) 
 New Key,Cnt,Y,Z,Elem
 Set X=""
 If Format["Q" Do 
 .Set Key=""
 .Set Len=$P(^POP(List),"\",5)
 .For  Set Key=$O(^POP(List,"D",Key)) Quit:Key=""  Set Y($P(^(Key),"\",1))=$S(Format["K":$E(Key,1,Len)_$J("",Len-$L(Key))_" ",1:"")_$P(^(Key),"\",2),Z(Key)=$P(^(Key),"\",1)
 If Format["P" Do 
 .Set Key=""
 .For  Set Key=$O(^POP("I",List,Key)) Quit:Key=""  Set Y(Key)=$S(Format["K":$P(^(Key),"\",1)_" ",1:"")_$P(^(Key),"\",2),Z($P(^(Key),"\",1))=Key
 If Format'["P",Format'["W",Format'["Q" Do 
 .For Key=1:1:$L(List,"\") Set Elem=$P(List,"\",Key) Set:$L(Elem) Y(Key)=$S(Format["K":$P(Elem,";",1)_" ",1:"")_$P(Elem,";",2),Z($P(Elem,";",1))=Key
 If Format["W" Do 
 .Set Key="",Cnt=0
 .For  X List Quit:Key=""  S Cnt=Cnt+1,Y(Cnt)=$S(Format["K":$P(X,"\",1)_" | ",1:"")_$P(X,"\",2)_"\"_$P(X,"\",1),Z($P(X,"\",1))=Cnt
 Set Y(0)=$O(Y(""),-1)
 If Format[";" For Key=1:1:$L(Val,";") If $L($P(Val,";",Key)) Set:$D(Z($P(Val,";",Key))) Cnt=Z($P(Val,";",Key)),X=X_";"_Y(Cnt)
 If Format'[";" For Key=1:1:$L(Val) Set:$D(Z($E(Val,Key))) Cnt=Z($E(Val,Key)),X=X_";"_Y(Cnt)
 Set $E(X)=""
xxx Quit X