proc ;PROCEDURES & FUNCTIES ;PROC; Beschrijving zie PROCBES [ 07/11/97   1:20 PM ]
 Q
 ;
 ; Inkey
IK G IK^PROC1
 ;
 ;
 ; Cusor vertaallist
CVL S R="\[1~;FI\[5~;PP\[6~;NP\[A;UP\[B;DO\[D;UP\[C;DO\[28~;HELP\[33~;HO\[34~;EN\"
 I $D(^cLOG(boot,"DEV",$I)),$P(^($I),D,1)="MC" S R="\[1~;HELP\[2~;HO\[3~;PP\[4~;FI\[5~;EN\[6~;NP\[A;UP\[B;DO\[D;UP\[C;DO\[32~;PS\~;PB\"
 Q
 ;
 ;
 ; Format number
FN S:'$D(FN(3)) FN(3)=0 S:'$D(FN(4)) FN(4)="N" S R=FN(1) I FN(4)["C",'R,"0"'[R G FN2
 S:FN(4)["$" FN(3)=0,FN(2)=FN(2)-2
 S R=$J(R,0,FN(3)) I 'R,$P(FN(4),"N",2)'[0 S R="" G FN3
 S FNt=" ",FNd="" S:FN(3) FNd=","_$P(R,".",2) S:R<0 FNt="-",R=-R S R=$P(R,".",1)
 S:$P(FN(4),"N",2)["+" FNt="" S:FNt=" "&($P(FN(4),"N",1)["-") FNt="" G FN1:'FN(2),FN1:$P(FN(4),"N",1)'[0
 S FNz="",$P(FNz,0,FN(2)-$L(FNt))=0,FNz=1_FNz S:FN(3) FNz=$E(FNz,1,$L(FNz)-(FN(3)+1)) S:$L(R)<$L(FNz) R=$E(FNz+R,2,99)
FN1 I FN(4)'["." F FNp=3,7,11 S FNe=$L(R) Q:FNe'>FNp  S R=$E(R,1,FNe-FNp)_"."_$E(R,FNe-FNp+1,FNe)
 S R=R_FNd I FN(2),$P(FN(4),"N",1)[0 F FNz=1:1 Q:$L(R)=(FN(2)-$L(FNt))!("0."'[$E(R,1))  S R=$E(R,2,99)
 S R=$S($P(FN(4),"N",1)["-":FNt,1:"")_R_$S($P(FN(4),"N",1)["-":"",1:FNt)
FN2 I FN(2),$L(R)>FN(2) S R="",$P(R,"#",FN(2))="#"
 S:FN(4)["$" R=R_",-"
FN3 Q
 ;
 ;
 ; Format line
 N OX
FL S (FLs,FLt)="" I '$D(FL(2)) S FL(2)=""
 I FL(2) S FP=FL(2) W @F
 If FL(1)?.U S FL(1)=^LD("L",FL(1))
FL1 S FLt=FLt+1,FLv=$P(FL(1),D,FLt),FLl=$P(FLv,U,4) G FL7:FLv="" S R="" G FL2:'$L($P(FLv,U,1)) ;ophalen data
 I $P(FLv,U,1)?.N S R=$P(FL(3),D,$P(FLv,U,1))
 E  I $P(FLv,U,1)?1.E1"."1.N S R=$P(FL(3,$P($P(FLv,U,1),".",1)),D,$P($P(FLv,U,1),".",2))
 E  X "S R="_$P(FLv,U,1)
 I $P(FLv,U,8)'="" S OX=$G(X),X=R X "S R="_$P(FLv,U,8) S X=OX
FL2 G FL3:$P(FLv,U,2)'["N" S FN(1)=R,FN(2)=FLl,FN(3)=$P(FLv,U,5),FN(4)=$P(FLv,U,2) ;verwerking numerieke data
 D FN
FL3 G FL4:'FLl S R=$E(R,1,FLl)
 I $P(FLv,U,3)="L" S R=R_$J("",FLl-$L(R)) ;alignering
 E  I $P(FLv,U,3)="R" S R=$J(R,FLl)
 E  I $P(FLv,U,3)="C" S R=$J("",(FLl-$L(R))\2)_R_$J("",FLl-$L(R)-((FLl-$L(R))\2))
 E  S R="",$P(R,"#",FLl)="#"
FL4 G FL6:'$L(FL(2)),FL5:'$L($P(FLv,U,7)) ;print
 I $P(FLv,U,7)?.N S FLb=$P(FL(3),D,$P(FLv,U,7))
 E  X "S FLb="_$P(FLv,U,7)
 I '$G(FL(4)),FLb W @FMTB,R,@FMTb,$P(FLv,U,6) G FL6
FL5 W R,$P(FLv,U,6)
FL6 S FLs=FLs_R_$P(FLv,U,6) G FL1 ;concatinering
FL7 S R=FLs
 Q
 ;
 ;
 ; Lijst parameters
LPar S DLt=@(DL(1)_"(1)") F DLi=$L(DLt):-1 Q:" ,)"'[$E(DLt,DLi)  ; instellen van de referenties
 S DLt=$E(DLt,1,DLi) S:DLt'["(" DLt=DLt_"(" S:$E(DLt,$L(DLt))'="(" DLt=DLt_","
 S @(DL(1)_"(1)")=DLt,DLt=DLt_"DLv)"
 D IPar
 Q
 ;
 ; Write list
WL D LPar S DLse=0,DLvx=DLv S:'$D(@(DL(1)_"(8)")) @(DL(1)_"(8)")=""
 I @(DL(1)_"(8)")[D K FL S FL(1)=@(DL(1)_"(8)"),FL(2)="" D FL S @(DL(1)_"(8)")=R
 G WL2:$D(@(DL(1)_"(9)")) S @(DL(1)_"(9)")=0
WL1 S DLv=DLv+10 G WL1:$D(@DLt) F DLv=DLv-1:-1:1 I $D(@DLt) S @(DL(1)_"(9)")=DLv Q
WL2 S DLv=DLvx,@(DL(1)_"(4)")=DLal,@(DL(1)_"(5)")=DLll,DLti=1 D STi
 S DLi=DLbl-1 S:$D(DL(2)) DLb=DL(2) S:$D(DL(3)) DLe=DL(3) D WP K DL(2),DL(3),DLn S $P(DLse,D,1)=@(DL(1)_"(9)")
 Q
 ;
 ; Init parameters
IPar S:@(DL(1)_"(2)")?.U @(DL(1)_"(2)")=^LD("L",@(DL(1)_"(2)"))
 S DLInc=1 S:@(DL(1)_"(2)")?1N1"F" DLInc=+@(DL(1)_"(2)")
 S DLbl=@(DL(1)_"(3)"),DLal=25-DLbl\DLInc*DLInc I $D(@(DL(1)_"(4)")),@(DL(1)_"(4)") S DLal=@(DL(1)_"(4)")
 S DLll=80 I $D(@(DL(1)_"(5)")),@(DL(1)_"(5)") S DLll=@(DL(1)_"(5)")
 S DLsl=0 I $D(@(DL(1)_"(6)")),@(DL(1)_"(6)") S DLsl=@(DL(1)_"(6)")
 S DLo=1 S:DLal<DLsl DLo=DLsl-DLal+1 I $D(@(DL(1)_"(7)")),@(DL(1)_"(7)") S DLo=@(DL(1)_"(7)")
 S DLse=0 I $D(@(DL(1)_"(9)")),@(DL(1)_"(9)") S DLse=@(DL(1)_"(9)")_D_DLo S:DLsl $P(DLse,D,2)=DLsl
 S DLc="" I $D(@(DL(1)_"(10)")),$L(@(DL(1)_"(10)")) S DLc=@(DL(1)_"(10)")
 S DLv=DLo+DLal,DLb=1,DLe=24
 Q
 ;
 ; Write page
WP S DLv=DLo-1 ; verwerken van de data
WP1 S DLv=DLv+1 I '$D(@DLt) G WP2
 G WP3:(DLv-DLo+1)>DLal D WLn G WP1
WP2 F DLi=DLi+1:1:(DLbl+DLal-1) S FP=DLi*100+1 W @F,@F2  ; resterende lijnen wissen
WP3 D Par
 Q
 ;
 ; Enable line
EL S DLt=@(DL(1)_"(1)")_"DLv)" D IPar S DLvx=DLv,DLv=DLsl D WLn S DLv=DLvx
 Q
 ;
 ; Disable line
DL S DLt=@(DL(1)_"(1)")_"DLv)" D IPar S DLvx=DLv,DLv=DLsl,DLsl=0 D WLn S DLv=DLvx
 Q
 ;
 ; Write line
WLn S DLi=DLbl+DLv-DLo Q:DLi<DLb!(DLi>DLe)
 S FL(2)=DLi*100+1,FL(3)=@DLt
 S DLcb=""
 I $L(DLc) X "S DLcb=$$"_DLc_"(DLv,FL(3))"
 S FL(1)=@(DL(1)_"(2"_$S(DLcb="":"",1:",DLcb")_")")
 S FL(4)=0 I DLsl=DLv W @FMTB S FL(4)=1
 D FL W @FMTb I $L(R)<@(DL(1)_"(5)") W @F2
 S $P(DLse,D,2)=$S(DLsl:DLsl,1:DLo)
 I $D(DLf),DLf="FI",DLv=DLn D WFi
 Q
 ;
 ; Write find
WFi I R[DLz S FP=FP+$L($P(R,DLz,1)),R=$P(R,DLz,2,999) W @F,@FMTI,DLz,@FMTi S FP=FP+$L(DLz) G WFi
 Q
 ;
 ; Parameters invullen
Par S @(DL(1)_"(6)")=DLsl,@(DL(1)_"(7)")=DLo
 Q
 ;
 ; Scroll area bepalen
SCa S FP=DLbl_$E(100+DLbl+DLal-1,2,3) W @FSC
 Q
 ;
 ; Page parameters
PPar S:DLo<1 DLo=1 I DLsl S DLsl=DLo I DLf="EN" S DLsl=DLv
 I DLo'=@(DL(1)_"(7)") D WP
 Q
 ;
 ; Opzoeken laatste lijn
LLn F DLv=DLv-1:-1:1 I $D(@DLt) S DLo=DLv-DLal+1 Q
 S DLv=DLv-DLInc+1
 Q
 ;
 ; Show selected line
SSl I $D(DLse),DLse,$L(@(DL(1)_"(8)")) D
 .I '$P(@(DL(1)_"(8)"),"`",2) S $P(@(DL(1)_"(8)"),"`",2)=-1
 .S DLti=1,FP=DLbl+$P(@(DL(1)_"(8)"),"`",2)
 .S:FP<1 FP=1 S:FP>24 FP=24
 .S FP=FP*1000+DLll-8
 .W @FE,@FMTI,@FMTB,$J($P(DLse,D,2)-1\DLInc+1_"/"_(+DLse-1\DLInc+1),8)," ",@FMTb,@FMTi
 Q
 ;
 ; Show titel
STi I $D(DLti),DLti,$L(@(DL(1)_"(8)")) D
 .I '$P(@(DL(1)_"(8)"),"`",2) S $P(@(DL(1)_"(8)"),"`",2)=-1
 .S DLti=0,FP=DLbl+$P(@(DL(1)_"(8)"),"`",2)
 .S:FP<1 FP=1 S:FP>24 FP=24
 .S FP=FP*100+1
 .W @F,@FMTI,$P(@(DL(1)_"(8)"),"`"),$J("",DLll-$L($P(@(DL(1)_"(8)"),"`"))),@FMTi
 Q
 ;
 ; Line up
LUp D SCa I 'DLsl G LUp3:DLo=1 S DLv=DLo-DLInc G LUp2
 I DLsl=1 S DLf="" G LUp3
 S DLvx=DLv,DLv=DLsl,DLsl=DLsl-DLInc I $D(DLml),DLml D WLn:DLal>1 G LUp1
 D WLn:DLal>1&'DLfe
 S IK(2)=0 D IK K IK(2) S (DLf,DLfx)=R,DLfe=1
LUp1 S DLv=DLv-DLInc I DLv'<DLo G LUp3:'$D(DLml),LUp3:'DLml D WLn G LUp3
LUp2 S DLv=DLv+DLInc F DLtt=1:1:DLInc S (DLv,DLo)=DLo-1,FP=DLbl*100+1 W @F W:DLal>1 @FIN D WLn S DLfe=0 I 'DLsw S DLsw=""
 I $D(DL(3)) S DLsw=0
LUp3 S DLv=DLo+DLal D Par S FP=124 W @FSC
 Q
 ;
 ; Line down
LDo D SCa I 'DLsl G LDo3:'$D(@DLt),LDo2
 S DLvx=DLv,DLv=DLsl+DLInc I '$D(@DLt) S DLf="" G LDo3
 S DLv=DLsl,DLsl=DLsl+DLInc I $D(DLml),DLml D WLn:DLal>1 G LDo1
 D WLn:DLal>1&'DLfe
 S IK(2)=0 D IK K IK(2) S (DLf,DLfx)=R,DLfe=1
LDo1 S DLv=DLv+DLInc I DLv<DLvx G LDo3:'$D(DLml),LDo3:'DLml D WLn G LDo3
LDo2 F DLtt=1:1:DLInc S DLo=DLo+1,FP=DLbl*100+1 W @F W:DLal>1 @FDL D WLn S DLv=DLv+1,DLfe=0 I 'DLsw S DLsw=""
 I $D(DL(3)) S DLsw=0
LDo3 S:DLsl DLv=DLvx D Par S FP=124 W @FSC
 Q
 ;
 ; First page
FPag S DLfe=0,DLo=1 I DLsl>1,DLo=@(DL(1)_"(7)") S DLvx=DLv,DLv=DLsl,DLsl=1 D WLn S DLv=1 D WLn,Par S DLv=DLvx G FPag1
 S:DLsl DLsl=1 D PPar
FPag1 Q
 ;
 ; Last page
LPag S DLfe=0,DLv=DLv+10 G LPag:$D(@DLt) D LLn S:DLo<1 DLo=1
 I DLsl,DLsl'=DLv,DLo=@(DL(1)_"(7)") S DLvx=DLv,DLv=DLsl,DLsl=DLvx D WLn S DLv=DLsl D WLn,Par G LPag1
 D PPar
LPag1 Q
 ;
 ; Prev Page
PPag S DLfe=0,DLo=DLo-DLal D PPar
 Q
 ;
 ; Next page
NPag S DLfe=0,DLo=DLo+DLal,DLv=DLo+DLal I '$D(@DLt) D LLn G NPag1:DLv=1 S:DLsl DLf="EN" S:'DLsl DLv=DLv+1
 D PPar
NPag1 Q
 ;
 ; Selecteer procedure
Select I $D(DL(3)) S DLsw=1
 D @$S(DLf="UP":"LUp",DLf="DO":"LDo",DLf="PP":"PPag",DLf="NP":"NPag",DLf="HO":"FPag",DLf="EN":"LPag",DLf="FI":"Find^PROC1",1:"DLfcl")
 Q
 ;
 ; Dummy
DLfcl S DLf="" I DLfe D EL S DLfe=0
 Q
 ;
 ; Move list
ML S DLfe=0,DLt=@(DL(1)_"(1)")_"DLv)",DLf=DL(2),DLml=1 D IPar,Select K DLml
 Q
 ;
 ; Scroll list
SL S DLfe=0,DLt=@(DL(1)_"(1)")_"DLv)" D IPar,CVL K IK S:$D(DL(2)) R=R_DL(2) S IK(1)=R,DLsw=0
 I $D(DL(3)),DL(3)<0 S (IK(2),DL(3))=-DL(3)
SL1 I DLfe D EL,SSl S DLfe=0
 D IK S (DLf,DLfx)=R
SL2 D Select S IK(2)=3 S:$D(DL(3)) IK(2)=DL(3) I 'DLsw S DLsw=$S(DLsw=0:"",1:0)
 I DLfe S:'DLsw DLsw=0 G SL2:$L(DLf),SL1
 I $L(DLf) D SSl G SL1
 I DLfx="",'DLsw,'$D(DL(3)) D:$L(DLsw) SSl G SL1:$L(DLsw) D STi K IK(2) G SL1
 I DLfx="",'DLsw S DLsw=1 d SSl G SL1
 D STi S R=DLfx
 Q
 ;
 ; Position list
PL D LPar G PL1:DL(2)=DLbl D CL^PROC1 I DLsl>(DL(3)+DLo-1) S DLo=DLsl-DL(3)+1 D Par
 D Pba K DL(2),DL(3) D WL G PL4
PL1 G PL3:DL(3)>DLal I DL(3)=DLal K DL(2),DL(3) G PL4
 D SCa G PL2:DLsl'>(DL(3)+DLo-1)
 S FP=DLbl*100+1 W @F F DLi=1:1:DLal-DL(3)-(DLal-(DLsl-DLo+1)) W @FDL
 S DLo=DLo+DLi D Par
PL2 S FP=DLbl+DL(3)*100+1 W @F F DLi=1:1:DLal-DL(3) W @FDL
 S FP=124 W @FSC D Pba K DL(2),DL(3) G PL4
PL3 D Pba S DL(2)=DLbl+DLal,DL(3)=DLbl+DL(3)-1 D WL
 S DLv=DLo+DLal-1 G PL4:$D(@DLt) D SCa,LLn S:DLo<1 DLo=1 S DLb=1,DLe=24
 S FP=DLbl*100+1 W @F F DLv=@(DL(1)_"(7)")-1:-1:DLo S DLo=DLv W @FIN D WLn Q:DLv=1
 D Par S FP=124 W @FSC
PL4 Q
 ;
 ; Nieuwe begin- en aantal lijnen
Pba S @(DL(1)_"(3)")=DL(2),@(DL(1)_"(4)")=DL(3)
 Q
 ;
YZ Q
 Q
Z X ^cZ Q
ZZ ; 09.12.91 -  8 u 50