vhLIST ;Lijst functies [ 10/07/2003  12:04 PM ]
 
INIT(sGrp,sId,L) 
 Goto INIT^vhLIST2
 
RENUMBER(L,sORef,sNoKill) 
 ;L kan zowel worden opgeroepen via .LijstDef als via $NA(Ref)
 Goto RENUMBER^vhLIST2
 
WRITE(L) 
 New D,sSelect,sOffset,sMax,sOldSel,sTop,sLeft,sBot,sRight,sLen
 New sDefFmt,sFetch,sSelAttr,sBGAttr,sMemAttr
 Do INITPAR
 Do WRAND^vhLIST2
 Do CALCSEL,INITFMT
 Do WLIST(1,sLen)
 Do WNOLINE^vhLIST2 Quit:'L("MAX")
 Do WDISPPOS:$P(L("POS"),"`",3)="S"
 Do SELECT(0),CLEAN
 Quit
 
REFRESH(L,sType,sLine) 
 If sType="H"!(sType="F") Goto REFRESH^vhLIST2
 If sType="L" Do LINE(.L,sLine)
 Quit
 
UPDATE(L,sWrite,sInitExe,sTravExe,sSelExe,sCompExe) 
 
 quit:'##class(vhLib.TerminalDevice).IsCurrentSessionATerminalSession() 
 
 ;sWrite : 1=Partieel, 2=Volledig, 0=Geen
 New D,sSelect,sOffset,sMax,sOldSel,sTop,sLeft,sBot,sRight,sLen
 New sDefFmt,sFetch,sSelAttr,sActie,sExit,sBGAttr,sMemAttr
 New sCnt,sMemOff,sRec,sI,sCheck
 Do INITPAR
 Set:'$L($G(sWrite)) sWrite=1
 Set:$G(sTravExe)="" sTravExe=L("UPTRAV")
 Set:$G(sSelExe)="" sSelExe=$G(L("UPSEL"))
 Set:$G(sCompExe)="" sCompExe=$G(L("UPCOMP"))
 Set:$G(sInitExe)="" sInitExe=$G(L("UPINIT"))
 Set sRec="",sCnt=0
 Set:sCompExe="" sCompExe="@`$G(@sFetch@(sCnt))=sRec"
 Do EXECS^vhRES(sInitExe,"","")
 Do:sWrite CALCSEL,INITFMT
 For  Do  Quit:sRec=""
 .Do EXECS^vhRES(sTravExe,"sRec","(sRec,sCnt)")
 .Quit:sRec=""
 .Set sCnt=sCnt+1
 .Do:$L(sSelExe) EXECS^vhRES(sSelExe,"sCheck","(sRec,sCnt,sSelect)")
 .Set:sCheck sSelect=sCnt ; Deze moet geselekteerd worden
 .Do EXECS^vhRES(sCompExe,"sCheck","(sRec,sCnt)")
 .Quit:sCheck  ; Niets verander
 .Set @sFetch@(sCnt)=sRec
 .If sWrite=1,sCnt>sOffset,sCnt'>(sOffset+sLen) Do WLIST(sCnt-sOffset,sCnt-sOffset)
 Set sMemOff=sOffset
 For sI=sCnt+1:1:L("MAX") Kill @sFetch@(sI) Set sMemOff=99999
 Set L("MAX")=sCnt
 Do:sWrite CALCSEL
 If sOffset'=sMemOff!(sWrite=2) Do WLIST(1,sLen) Set sOldSel=""
 Do:sWrite SELECT(0)
 Do CLEAN
 Quit
 
SCROLL(L,sKeyEx,sTimeO,sNoFCS) 
 New D,sSelect,sOffset,sMax,sOldSel,sTop,sLeft,sBot,sRight,sLen
 New sDefFmt,sFetch,sSelAttr,sActie,sExit,sBGAttr,sMemAttr
 Do INITPAR,INITFMT
 Write @FCH
 Set sActie=""
 Set sTimeO=$G(sTimeO)
 Set sExit=""
 For  Quit:sExit  Do
 .Set sActie=$$IN^vhKEY("",$S($P(L("POS"),"`",3)="Q"&$L(sTimeO)&(sTimeO<3)!($P(L("POS"),"`",3)'="Q"):sTimeO,1:3),1)
 .If $L($G(sKeyEx)) Do EXECS^vhRES(sKeyEx,"zb","(zb)") If $L(zb) Set sActie=zb,sExit=1 Quit
 .If ";UP;DO;LE;RI;HO;EN;PP;NP;"'[(";"_sActie_";") Set sExit=$$EXECBUT^vhLIST2(sActie)
 .Else  If sActie="" Do CDISPPOS If $L(sTimeO) Set:(sTimeO'>3) sExit=1,zb=-1 Set sTimeO=sTimeO-3
 .Else  If sActie'="" Do @("M"_sActie_"(0)"),WDISPPOS
 Do CDISPPOS
 Do CLEAN
 Quit sActie
 
MOVE(L,sActie,sRedraw) 
 New D,sSelect,sOffset,sMax,sOldSel,sTop,sLeft,sBot,sRight,sLen,sMemSel
 New sDefFmt,sFetch,sSelAttr,sBGAttr,sMemAttr
 Quit:'L("MAX")
 Do INITPAR,INITFMT
 Set sMemSel=sSelect
 Do @("M"_sActie_"(sRedraw)")
 If sRedraw,sMemSel=sSelect Do
 .Do WLIST(sSelect-sOffset)
 .Do SELECT(0)
 Do CLEAN
 Quit
 
LINE(L,sNewSel) 
 New D,sSelect,sOffset,sMax,sOldSel,sTop,sLeft,sBot,sRight,sLen
 New sDefFmt,sFetch,sSelAttr,sBGAttr,sMemAttr
 Quit:'L("MAX")
 Do INITPAR
 Quit:L("OFFSET")'<sNewSel
 Quit:L("OFFSET")+sLen<sNewSel
 Do INITFMT
 Do WLIST(sNewSel-sOffset)
 Do:sNewSel=sSelect SELECT(0)
 Do CLEAN
 Quit
 
ENABLE(L,sNewSel,sRedraw) 
 New D,sSelect,sOffset,sMax,sOldSel,sTop,sLeft,sBot,sRight,sLen
 New sDefFmt,sFetch,sSelAttr,sBGAttr,sMemAttr
 Do INITPAR
 Quit:'L("MAX")
 Do INITFMT
 Set sSelect=sNewSel
 Do CALCSEL
 If sOffset'=+$G(L("OFFSET")) Do
 .Do WLIST(1,sLen)
 Else  If $G(sRedraw) Do
 .Do WLIST(sSelect-sOffset)
 Do SELECT(0),CLEAN
 Quit
 
DISABLE(L,sRedraw) 
 New D,sSelect,sOffset,sMax,sOldSel,sTop,sLeft,sBot,sRight,sLen
 New sDefFmt,sFetch,sSelAttr,sBGAttr,sMemAttr
 Do INITPAR
 Quit:'L("MAX")
 Do INITFMT
 Set sPos=sOldSel-sOffset
 Do WSELECT(sPos,0,$G(sRedraw))
 Set sOldSel=""
 Do CLEAN
 Quit
 
POSITION(L,Bot) 
 
 ;*** LowLevel ***
MLE(sRedraw) If $D(L("B")) Do MOVEBUT^vhLIST2(-1) Quit
 Goto MUP2
MUP(sRedraw) 
MUP2 New sQty,sSelOld
 ;Goto:L("SELECT")="" MPP2
 If L("SELECT")="" Set sSelect=sOffset+1
 Quit:sSelect=0
 Set sSelOld=sSelect
 Set sSelect=$$ORDER(sSelect,1,-1)
 Quit:sSelect=sSelOld
 Goto MDO3:sSelect>sSelOld  ; blijkbaar is het de andere kant uitgegaan
MUP3 Set sQty=sOffset+1-sSelect ; Aantal positie dat er gescrolled moet worden
 If sQty>0 Do:sQty<sLen WMOVE(1,sLen-sQty,1+sQty) Set sOffset=sSelect-1 Set:sOffset<0 sOffset=0 Do WLIST(1,$S(sQty<sLen:sQty,1:sLen))
 Do SELECT(sRedraw)
 Quit
 
MRI(sRedraw) If $D(L("B")) Do MOVEBUT^vhLIST2(1) Quit
 Goto MDO2
MDO(sRedraw) 
MDO2 New sQty,sSelOld
 ;Goto:L("SELECT")="" MNP2
 If L("SELECT")="" Set sSelect=sOffset+sLen
 Quit:sSelect=0
 Do:sOffset+(sLen*2)>L("MAX") CBMORE(sLen)
 Set sSelOld=sSelect
 Set sSelect=$$ORDER(sSelect,1,1)
 Quit:sSelect=sSelOld
 Goto MUP3:sSelect<sSelOld  ; blijkbaar is het de andere kant uitgegaan
MDO3 Set sQty=sSelect-sOffset-sLen ; Aantal positie dat er gescrolled moet worden
 ;If sQty>0 Do WMOVE(1+sQty,sLen,1) Set sOffset=sSelect-sLen Do WLIST(sLen-sQty+1,sLen)
 If sQty>0 Do:sQty<sLen WMOVE(1+sQty,sLen,1) Set sOffset=sSelect-sLen Do WLIST($S(sQty<sLen:sLen-sQty+1,1:1),sLen)
 Do SELECT(sRedraw)
 Quit
 
MNP(sRedraw) 
MNP2 New sOldOff
 Quit:sSelect=0
 Do:sOffset+(sLen*2)>L("MAX") CBMORE(sLen)
 Set sOldOff=sOffset
 Set sOffset=sOffset+sLen
 Set:L("MAX")-sLen<sOffset sOffset=L("MAX")-sLen
 Set:sOffset<0 sOffset=0
 Quit:sOldOff=sOffset
 Set sSelect=$$ORDER(sOffset+1,0,1)
 Set sOldSel=""
 Do WLIST(1,sLen),SELECT(sRedraw)
 Quit
 
MPP(sRedraw) 
MPP2 New sOldOff
 Quit:sSelect=0
 Set sOldOff=sOffset
 Set sOffset=sOffset-sLen
 Set:sOffset<0 sOffset=0
 Quit:sOldOff=sOffset
 Set sSelect=$$ORDER(sOffset+1,0,1)
 Set sOldSel=""
 Do WLIST(1,sLen),SELECT(sRedraw)
 Quit
 
MHO(sRedraw) 
 New sOldOff
 Quit:sSelect=0
 Set sOldOff=sOffset 
 Set sOffset=0
 If sOldOff'=sOffset Do WLIST(1,sLen) Set sOldSel=""
 Set sSelect=$$ORDER(1,0,1)
 Do SELECT(sRedraw)
 Quit
 
MEN(sRedraw) 
 New sOldOff
 Quit:sSelect=0
 Do CBMORE()
 Set sOldOff=sOffset 
 Set sOffset=L("MAX")-sLen
 Set:sOffset<0 sOffset=0
 If sOldOff'=sOffset Do WLIST(1,sLen) Set sOldSel=""
 Set sSelect=$$ORDER(L("MAX"),0,-1)
 Do SELECT(sRedraw)
 Quit
 
SELECT(sRedraw) Quit:L("SELECT")=""
 Do:sOldSel WSELECT(sOldSel-sOffset,0,sRedraw)  
 Do WSELECT(sSelect-sOffset,1,sRedraw)
 Set sOldSel=sSelect
 Quit
 
INITPAR New sPos
 Set sFetch=L("F")
 Set sPos=$P(L("POS"),"`")
 Set sTop=$P(sPos,";")
 Set sLeft=$P(sPos,";",2) Set:'sLeft sLeft=1
 Set sBot=$P(sPos,";",3) Set:'sBot sBot=sScr("ROW")
 Set sRight=$P(sPos,";",4) Set:'sRight sRight=sScr("KOL")
 Set D=$C($P(L("SET"),"`",2)) Set:D="" D="\"
 Set sLen=sBot-sTop+1
 Set sBGAttr=$P($G(L("SET")),"`",4),sMemAttr=-1
 Set sSelect=L("SELECT")
 Set sOffset=+$G(L("OFFSET"))
 Set sOldSel=$P($G(L("OFFSET")),"`",2)
 Set:L("SELECT")="" sSelect=sOffset+1
 Set:'$G(L("MAX")) L("MAX")=+$O(@sFetch@(""),-1)
 Do:'L("MAX") CBMORE(sSelect+sLen+1)
 Quit
 
INITFMT New sAttr,sI
 Set sDefFmt=$P($G(L("SET")),"`",6)
 Set:'$L(sDefFmt) sDefFmt=$O(L("FMT",""))
 Set sAttr=$P($G(L("SET")),"`",5)
 Set sSelAttr=""
 For sI=1:1:$L(sAttr) Set sSelAttr=sSelAttr_";"_($F("B  UK I",$E(sAttr,sI))-1)
 Quit
 
CALCSEL If L("SELECT")'="" Do 
 .Set:sSelect>L("MAX") sSelect=+L("MAX")
 .Set:L("MAX")&'sSelect sSelect=1
 .Set:sOffset+sLen<sSelect sOffset=sSelect-1
 .Set:sOffset+1>sSelect sOffset=sSelect-1
 .Set L("SELECT")=sSelect
 Set:sOffset+sLen>L("MAX") sOffset=L("MAX")-sLen
 Set:sOffset<0 sOffset=0
 If L("SELECT")=""
 .Set:sOffset+sLen>L("MAX") sOffset=L("MAX")-sLen
 .Set:sOffset<0 sOffset=0
 .Set sSelect=sOffset+1
 Quit
 
CLEAN Write @FMTCL Write:'$G(sNoFCS) @FCS
 Set L("OFFSET")=sOffset_"`"_sOldSel
 Set:$L(L("SELECT")) L("SELECT")=+sSelect
 Quit
 
ORDER(sSelect,Qty,Dir) ; Volgend/Vorig met callback select
 New sCheck
 Set sCheck=0
 For  Do  Quit:sCheck
 .Set sSelect=sSelect+(Dir*Qty)
 .Set sSelect=$S(sSelect<1:1,sSelect>L("MAX"):L("MAX"),1:sSelect)
 .If $$CBSEL(sSelect) Set sCheck=1 Quit
 .Set Qty=1
 .Set:sSelect=1 Dir=1
 .Set:sSelect=L("MAX") Dir=-1
 Quit sSelect
 
CBSEL(sSelect) 
 New sCheck,sExec
 Set sExec=$G(L("CS"))
 Quit:'$L(sExec) 1
 Set sRec=$G(@sFetch@(sSelect))
 Do EXECS^vhRES(sExec,"sCheck","(sSelect,sRec)")
 Quit sCheck
 
CBMORE(sQty) ; Callback voor Fetch More
 New sExec,sMax,sRec,sWMore
 Set:'$G(sQty) sQty=999999
 Set sExec=$G(L("CM"))
 Quit:'$L(sExec) 
 ; Schrijven van *MEER*
 If $P(L("POS"),"`",3)="Q"!($P(L("POS"),"`",3)="P"),L("MAX") Do
 .Set sPos=$P(L("POS"),"`",4),FP=$P(sPos,";",1)
 .Do:$P(L("POS"),"`",3)="P" STORE^vhTERMINA(FP,FP)
 .Set FP=FP*1000+$P(sPos,";",4)-5
 .Write @FE,@FMTK,"*MEER*",@FMTCL
 .Set sWMore=1
 Set sMax=L("MAX")
 Set sRec=$S(sMax:@sFetch@(sMax),1:"")
 Do EXECS^vhRES(L("CM"),"sMax","(sMax,sQty,sRec)")
 ; Wissen van *MEER*
 If $G(sWMore) Do 
 .Do COPY^vhTERMINA($P(sPos,";"),$P(sPos,";",2),$P(sPos,";"),$P(sPos,";",4),sScr("PAGE"),$P(sPos,";"),$P(sPos,";",2),1)
 .;Set sScr("PAGE")=sScr("PAGE")-1
 Kill:sMax<0!(L("MAX")=sMax) L("CM")
 Set L("MAX")=$S(sMax<0:-sMax,1:sMax)
 Quit
 
WLIST(sT,sB) 
 New sI,sExec,sWrite
 Set sWrite=1+($P(L("SET"),"`",3)["L")
 Do FILL^vhTERMINA(sTop+sT-1,sLeft,sTop+$G(sB,sT)-1,sRight,"",sBGAttr)
 Set sExec=$S($D(L("N")):"N "_L("NEW")_" ",1:"")_"D WONE(sI,sWrite)"
 For sI=sT:1:$G(sB,sT) X sExec
 Quit
 
WONE(sPos,sWrite) 
 New sFL,sRec,sSelect,sFmt
 Set FP=sTop-1+sPos
 Set sSelect=sOffset+sPos
 Quit:'$D(@sFetch@(sSelect))
 Set (sRec,sFL(1))=@sFetch@(sSelect)
 Set sFmt=""
 Do:$D(L("CF")) EXECS^vhRES(L("CF"),"sFmt","(sSelect,sRec)")
 If $E(sFmt)="&" Do  Quit
 .If $E(sFmt,1,4)="&F&S"!($E(sFmt,1,4)="&S&F") Do WSEPAR^vhLIST2(sPos,$E(sFmt,5,999),0) Quit
 .If $E(sFmt,1,2)="&S" Do WSEPAR^vhLIST2(sPos,$E(sFmt,3,999),0) Quit
 .If $E(sFmt,1,2)="&F" Do WTXT^vhLIST2(sPos,$E(sFmt,3,999),1) Quit
 Set FP=FP*100+sLeft
 Write @F
 Do LIJN^vhFMT("L(""FMT"","""_$S(sFmt="":sDefFmt,1:sFmt)_""")",sWrite)
 Set:sOldSel=sSelect sOldSel=""
 Quit
 
WMOVE(sT,sB,sTo) 
 Do COPY^vhTERMINA(sTop+sT-1,sLeft,sTop+sB-1,sRight,1,sTop+sTo-1,sLeft,1)
 Quit
 
WSELECT(sPos,sIsSel,sRedraw) 
 Quit:'L("SELECT")  ; Offset lijst
 Quit:sPos<1  ; Voorbij bovenkant
 Quit:sPos>sLen  ; Voorbij onderkant
 Set sPos=sTop+sPos-1
 Do:sRedraw WLIST(sPos-sTop+1)
 Write:'sRedraw!sIsSel $C(27,91),sPos,";",sLeft,";",sPos,";",sRight,sSelAttr,"$t"
 Quit
 
WDISPPOS Quit:$P(L("POS"),"`",3)="" 
 If $P(L("POS"),"`",3)="S" Do WSCROL Quit
 Quit:'L("MAX")
 New sMax,sLen,sJ,sPos
 Set sMax=$S($D(L("CM")):"...",1:L("MAX"))
 Set sLen=$L(sMax) Set:sLen<$L(sSelect) sLen=$L(sSelect) Set:sLen<2 sLen=2
 Set sPos=$P(L("POS"),"`",4),FP=$P(sPos,";",1)
 Do:$P(L("POS"),"`",3)="P" STORE^vhTERMINA(FP,FP)
 Set FP=FP*1000+$P(sPos,";",4)-1-sLen-sLen
 Set $P(sPos,";",2)=FP#1000
 Do WATTR^vhRES($P(L("POS"),"`",5))
 Write @FE,$J("",sLen*2+1-$L(sMax)-$L(sSelect)),sSelect,"/",sMax
 Set $P(L("POS"),"`",3,4)="Q`"_sPos
 Quit
 
WSCROL New sPos,sLen,sScrol,sScrolT,sScrolB,sAttr,sString
 Set sPos=$P(L("POS"),"`",4)
 Set sLen=sBot-sTop+1
 Set sScrol=0,sString="13" ;sScrolT=0,sScrolB=0
 If L("MAX")>sLen Do
 .Set sScrol=sOffset*sLen\(L("MAX")-sLen)+1
 .Set:sOffset=0 sScrol=1,sString=3
 .Set:sOffset'<(L("MAX")-sLen) sScrol=sLen,sString=1
 .Set:sScrol+$L(sString)-1>sLen sScrol=sLen-$L(sString)+1
 Quit:sScrol=$P(sPos,";")&($L(sString)=$P(sPos,";",2))
 Do WATTR^vhRES("")
 Do VLIJN^vhTERMINA($P(sPos,";",4),sTop,sBot,"","",0)
 Set $P(sPos,";",1,2)=sScrol_";"_$L(sString)    
 Set $P(L("POS"),"`",4)=sPos
 Quit:'sScrol
 Set FP=sTop+sScrol-1*1000+$P(sPos,";",4)
 Write *27,"(>" ; Technical ON
 For sI=1:1:$L(sString) Do
 .Write @FE,$C($S($E(sString,sI)=1:68,1:69))
 .Set FP=FP+1000
 Write @F8 ; Technical OFF
 Quit
 
CDISPPOS ; Herstel PositieDisplay
 New sPos
 Quit:$P(L("POS"),"`",3)'="Q"
 Set sPos=$P(L("POS"),"`",4)
 Do COPY^vhTERMINA($P(sPos,";"),$P(sPos,";",2),$P(sPos,";"),$P(sPos,";",4),sScr("PAGE"),$P(sPos,";"),$P(sPos,";",2),1)
 Set sScr("PAGE")=sScr("PAGE")-1
 Set $P(L("POS"),"`",3)="P"
 Quit