DDSU ;SFISC/MLH-PROCESS HELP ;10:48 AM 6 Sep 2006
;;22.0;VA FileMan;**4,3,54,151**;Mar 30, 1999;Build 10
;Per VHA Directive 2004-038, this routine should not be modified.
LIST ;
D FM:'$D(DDS),SC:$D(DDS)
Q
;
SC ;Screen Help
N A0,A1,A2,A3,A4,A5,A6,DDSB1,X,Y
K DTOUT,DUOUT
;
W $P(DDGLVID,DDGLDEL,9) S X=$G(IOM,80)-1 X ^%ZOSF("RM")
I $D(DDQ)#2,DDQ<(IOSL-1),DDQ>DDSHBX!$P(DDQ,U,2)!$D(DDIOL) S DY=$P(DDQ,U),DX=$P(DDQ,U,2)
E D CLRMSG^DDS S DY=DDSHBX
X DDXY
;
S:$G(DDD,5)=5 DDD=1
S:$D(DDO) DDSB1=DDO
S DDM=1,DDO=.5
S (A0,DIY,X)="",A1=0,A5=$S(DDD=2:$O(DS(0)),1:$O(DDH(A0)))
K A2,DDSQ
;
F D SC1 Q:DDO'<1!(X=U)!'A0!DIY!$D(DTOUT)!$D(DUOUT)
;
I $D(DDSB1) S:DDO<1 DDO=DDSB1
E K DDO
;
S %=0
S DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
S:DDQ>DDSHBX DDM=1
I $D(A2) K DDD,DDH,DDQ S %=A2 S:%'=1 DDSQ=1 D CLRMSG^DDS G QQ
I $D(DDC),DDC'<0 D SV
E K DDD,DDH S DDSQ=1
;
QQ S A0=$X S X=0 X ^%ZOSF("RM") W $P(DDGLVID,DDGLDEL,8) S $X=A0
Q
;
SC1 S A6=A0,A0=$O(DDH(A0)) S:A6="" A6=A0-1
I 'A0,DDD Q:DDD=1 Q:DD<DS
;
S A4=$O(DDH(+A0,""))
I A4'="X"!(DY'>DDSHBX) S DY=DY+1 X DDXY
I A4="E" D SC2 Q
;
I $D(DDSCTRL) S:+DDSCTRL'=DDSCTRL!(DDSCTRL>3)!(DDSCTRL<1)!(DDSCTRL?.E1"."1N.N) DDSCTRL=2 ;DI*151
I $Y'<(IOSL-($G(DDSCTRL,2)))!'A0 D SC2 Q:DDO'<1!(X=U)!'A0!DIY!$D(DTOUT)!$D(DUOUT) S DY=DDSHBX+1,DX=0 X DDXY ;DI*151
Q:A4=""
;
D WR
;
I $Y'<(IOSL-1),'$D(DTOUT),'$D(DUOUT) D Q
. W ! D SC2
. W $P(DDGLVID,DDGLDEL,8) S X=0 X ^%ZOSF("RM") D REFRESH^DDSUTL
. W $P(DDGLVID,DDGLDEL,9) S X=$G(IOM,80)-1 X ^%ZOSF("RM")
. S DX=0,DY=DDSHBX X DDXY
;
S DY=$Y,DX=0
Q
;
SC2 S DX=0,DY=IOSL-1 X DDXY
W $S(DDD=1:$$EZBLD^DIALOG(8053),1:$$EZBLD^DIALOG(8081,A5_"-"_A6))_$P(DDGLCLR,DDGLDEL)
;
R X:DTIME E S DTOUT=1 K DDC G Q2
I X?1."^" S DUOUT=1,X=U K DDC G Q2
;
I X]"",X<A5!(X>A6) W $C(7) G SC2
E I X S:DDD["J" DDO=$O(DDH(X,"")) K DDC
D CLRMSG^DDS
S DDM=1
;
Q2 S DIY=X,DY=DDSHBX
Q
;
ASK W $P(A4,U,2)_$S(%'>2:"? ",1:"")_$S(%>0&(%<3):$P($$EZBLD^DIALOG(7001),U,%)_"// ",1:"")_$P(DDGLCLR,DDGLDEL)
S A2=0
R X:$G(DTIME,300) E S DTOUT=1,A2=-1 Q
;
I %>2 S A2=X Q
;
N %1 S %1=$$PRS^DIALOGU(7001,X) S:%1>0 X=$E($P(%1,U,2))
K %1
;
I "YyNn^"'[X W $C(7) X DDXY G ASK
I X]"","^Nn"[X S A2=2 K DDC Q
S:"Yy"[X A2=1
S:X=""&(%]"") A2=+%
S DDD=1
Q
;
SV ;Kill DDH array, but save the "ID" nodes and DDH itself
K A1,A2
S:$D(DDH("ID")) A1=DDH("ID")
S:$D(DDH("ID",1)) A2=DDH("ID",1)
K DDH S DDH=0
S:$D(A1) DDH("ID")=A1
S:$D(A2) DDH("ID",1)=A2
Q
;
FM ;FileMan help - Non screen
N A0,A1,A2,A3,A4,DDSDIW,DDSDIY,Y
S A0=""
F S A0=$O(DDH(A0)) Q:'A0 S DDSDIW=$X,DDSDIY=$Y D W I $G(DDD)>2,DDSDIW-$X!(DDSDIY-$Y) D STP Q:$D(DTOUT)
I $G(DIPGM)="DICQ1",$G(DP),$G(DIC("?N",DP)) D
. N DIZ S DIZ=0 D T Q
;
Q I '$D(DTOUT) D SV S DDH=0 Q
K DDH D:'DTOUT Q
. K DTOUT N % S %=$G(DIPGM) I %'="DICQ1",%'="DIEQ" Q
. S DUOUT=1 Q
Q
;
STP Q:$D(DD)[0!($D(DIY)[0) I DD+DIY'>79 W ?DD S DD=DD+DIY Q
;
T W !?3 S DD=DIY+3
I $Y>DIZ!'$Y D
. R "'^' TO STOP: ",%Y:$G(DTIME,300)
. E S DTOUT=1 K DDD
. W $C(13),$J("",15),$C(13) Q:$D(DTOUT)
. I %Y[U S DTOUT=0 K DDD
. D Y W ?3
Q
;
W S A4=$O(DDH(A0,"")) Q:A4="" Q:DDH(A0,A4)=""
W:'$D(DDD) !
I $G(DDD)=3,A4["T" K DDD
;
WR I A4["X" D Q
. N DDD,DIY,DDSXEC
. S DDSXEC=DDH(A0,A4)
. N DDH
. I $D(DDS) N DDSID S DDSID=1 S DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
. X DDSXEC
;
I A4["Q" D Q
. S A4=DDH(A0,A4),%=$P(A4,U,1)
. I $D(DDS) D ASK Q
. W $P(A4,U,2)
. D YN^DICN
;
I A4["T" D Q
. I DDH(A0,A4)[$C(0) D
.. S DX=$L(DDH(A0,A4),$C(0))-1
.. X DDXY
.. S DDH(A0,A4)=$TR(DDH(A0,A4),$C(0),"")
. W DDH(A0,A4)
;
I '$D(DDS),$G(DDD)'["J",A4'=+A4 Q
I $D(DDS),$G(DDD)=2!($G(DDD)["J") W A0,?7
;
W DDH(A0,A4)
I $D(DDH("ID")) D S:$D(DUOUT) DIY=U
. N DDD,DIY,DDSID
. S DDSID=DDH("ID")
. S:$D(DDH("ID",1))#2 DDSID(1)=DDH("ID",1)
. N DDH
. S:$D(DDSID(1))#2 DDH("ID",1)=DDSID(1) K DDSID(1)
. S Y=A4
. S:$D(DDS) DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_$X
. X DDSID
Q
;
Y D:'$D(DISYS) OS^DII
S $X=0,$Y=0
S DIZ=$S($D(DILN)&'$D(DIR0):DILN,1:21)
Q
;
Z D Y,T
Q
;
H S:'$D(A1) A1="T"
S DDH=$G(DDH)+1,DDH(DDH,A1)=DST
K A1,DST
D SC
Q
;#8053 Press 'RETURN' to continue...
;#8081 Choose |from-to| or '^'...
;#7001 Yes^No
DDSU ;SFISC/MLH-PROCESS HELP ;10:48 AM 6 Sep 2006
+1 ;;22.0;VA FileMan;**4,3,54,151**;Mar 30, 1999;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
LIST ;
+1 IF '$DATA(DDS)
DO FM
IF $DATA(DDS)
DO SC
+2 QUIT
+3 ;
SC ;Screen Help
+1 NEW A0,A1,A2,A3,A4,A5,A6,DDSB1,X,Y
+2 KILL DTOUT,DUOUT
+3 ;
+4 WRITE $PIECE(DDGLVID,DDGLDEL,9)
SET X=$GET(IOM,80)-1
XECUTE ^%ZOSF("RM")
+5 IF $DATA(DDQ)#2
IF DDQ<(IOSL-1)
IF DDQ>DDSHBX!$PIECE(DDQ,U,2)!$DATA(DDIOL)
SET DY=$PIECE(DDQ,U)
SET DX=$PIECE(DDQ,U,2)
+6 IF '$TEST
DO CLRMSG^DDS
SET DY=DDSHBX
+7 XECUTE DDXY
+8 ;
+9 IF $GET(DDD,5)=5
SET DDD=1
+10 IF $DATA(DDO)
SET DDSB1=DDO
+11 SET DDM=1
SET DDO=.5
+12 SET (A0,DIY,X)=""
SET A1=0
SET A5=$SELECT(DDD=2:$ORDER(DS(0)),1:$ORDER(DDH(A0)))
+13 KILL A2,DDSQ
+14 ;
+15 FOR
DO SC1
IF DDO'<1!(X=U)!'A0!DIY!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+16 ;
+17 IF $DATA(DDSB1)
IF DDO<1
SET DDO=DDSB1
+18 IF '$TEST
KILL DDO
+19 ;
+20 SET %=0
+21 SET DDQ=$SELECT(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
+22 IF DDQ>DDSHBX
SET DDM=1
+23 IF $DATA(A2)
KILL DDD,DDH,DDQ
SET %=A2
IF %'=1
SET DDSQ=1
DO CLRMSG^DDS
GOTO QQ
+24 IF $DATA(DDC)
IF DDC'<0
DO SV
+25 IF '$TEST
KILL DDD,DDH
SET DDSQ=1
+26 ;
QQ SET A0=$X
SET X=0
XECUTE ^%ZOSF("RM")
WRITE $PIECE(DDGLVID,DDGLDEL,8)
SET $X=A0
+1 QUIT
+2 ;
SC1 SET A6=A0
SET A0=$ORDER(DDH(A0))
IF A6=""
SET A6=A0-1
+1 IF 'A0
IF DDD
IF DDD=1
QUIT
IF DD<DS
QUIT
+2 ;
+3 SET A4=$ORDER(DDH(+A0,""))
+4 IF A4'="X"!(DY'>DDSHBX)
SET DY=DY+1
XECUTE DDXY
+5 IF A4="E"
DO SC2
QUIT
+6 ;
+7 ;DI*151
IF $DATA(DDSCTRL)
IF +DDSCTRL'=DDSCTRL!(DDSCTRL>3)!(DDSCTRL<1)!(DDSCTRL?.E1"."1N.N)
SET DDSCTRL=2
+8 ;DI*151
IF $Y'<(IOSL-($GET(DDSCTRL,2)))!'A0
DO SC2
IF DDO'<1!(X=U)!'A0!DIY!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
SET DY=DDSHBX+1
SET DX=0
XECUTE DDXY
+9 IF A4=""
QUIT
+10 ;
+11 DO WR
+12 ;
+13 IF $Y'<(IOSL-1)
IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
Begin DoDot:1
+14 WRITE !
DO SC2
+15 WRITE $PIECE(DDGLVID,DDGLDEL,8)
SET X=0
XECUTE ^%ZOSF("RM")
DO REFRESH^DDSUTL
+16 WRITE $PIECE(DDGLVID,DDGLDEL,9)
SET X=$GET(IOM,80)-1
XECUTE ^%ZOSF("RM")
+17 SET DX=0
SET DY=DDSHBX
XECUTE DDXY
End DoDot:1
QUIT
+18 ;
+19 SET DY=$Y
SET DX=0
+20 QUIT
+21 ;
SC2 SET DX=0
SET DY=IOSL-1
XECUTE DDXY
+1 WRITE $SELECT(DDD=1:$$EZBLD^DIALOG(8053),1:$$EZBLD^DIALOG(8081,A5_"-"_A6))_$PIECE(DDGLCLR,DDGLDEL)
+2 ;
+3 READ X:DTIME
IF '$TEST
SET DTOUT=1
KILL DDC
GOTO Q2
+4 IF X?1."^"
SET DUOUT=1
SET X=U
KILL DDC
GOTO Q2
+5 ;
+6 IF X]""
IF X<A5!(X>A6)
WRITE $CHAR(7)
GOTO SC2
+7 IF '$TEST
IF X
IF DDD["J"
SET DDO=$ORDER(DDH(X,""))
KILL DDC
+8 DO CLRMSG^DDS
+9 SET DDM=1
+10 ;
Q2 SET DIY=X
SET DY=DDSHBX
+1 QUIT
+2 ;
ASK WRITE $PIECE(A4,U,2)_$SELECT(%'>2:"? ",1:"")_$SELECT(%>0&(%<3):$PIECE($$EZBLD^DIALOG(7001),U,%)_"// ",1:"")_$PIECE(DDGLCLR,DDGLDEL)
+1 SET A2=0
+2 READ X:$GET(DTIME,300)
IF '$TEST
SET DTOUT=1
SET A2=-1
QUIT
+3 ;
+4 IF %>2
SET A2=X
QUIT
+5 ;
+6 NEW %1
SET %1=$$PRS^DIALOGU(7001,X)
IF %1>0
SET X=$EXTRACT($PIECE(%1,U,2))
+7 KILL %1
+8 ;
+9 IF "YyNn^"'[X
WRITE $CHAR(7)
XECUTE DDXY
GOTO ASK
+10 IF X]""
IF "^Nn"[X
SET A2=2
KILL DDC
QUIT
+11 IF "Yy"[X
SET A2=1
+12 IF X=""&(%]"")
SET A2=+%
+13 SET DDD=1
+14 QUIT
+15 ;
SV ;Kill DDH array, but save the "ID" nodes and DDH itself
+1 KILL A1,A2
+2 IF $DATA(DDH("ID"))
SET A1=DDH("ID")
+3 IF $DATA(DDH("ID",1))
SET A2=DDH("ID",1)
+4 KILL DDH
SET DDH=0
+5 IF $DATA(A1)
SET DDH("ID")=A1
+6 IF $DATA(A2)
SET DDH("ID",1)=A2
+7 QUIT
+8 ;
FM ;FileMan help - Non screen
+1 NEW A0,A1,A2,A3,A4,DDSDIW,DDSDIY,Y
+2 SET A0=""
+3 FOR
SET A0=$ORDER(DDH(A0))
IF 'A0
QUIT
SET DDSDIW=$X
SET DDSDIY=$Y
DO W
IF $GET(DDD)>2
IF DDSDIW-$X!(DDSDIY-$Y)
DO STP
IF $DATA(DTOUT)
QUIT
+4 IF $GET(DIPGM)="DICQ1"
IF $GET(DP)
IF $GET(DIC("?N",DP))
Begin DoDot:1
+5 NEW DIZ
SET DIZ=0
DO T
QUIT
End DoDot:1
+6 ;
Q IF '$DATA(DTOUT)
DO SV
SET DDH=0
QUIT
+1 KILL DDH
IF 'DTOUT
Begin DoDot:1
+2 KILL DTOUT
NEW %
SET %=$GET(DIPGM)
IF %'="DICQ1"
IF %'="DIEQ"
QUIT
+3 SET DUOUT=1
QUIT
End DoDot:1
QUIT
+4 QUIT
+5 ;
STP IF $DATA(DD)[0!($DATA(DIY)[0)
QUIT
IF DD+DIY'>79
WRITE ?DD
SET DD=DD+DIY
QUIT
+1 ;
T WRITE !?3
SET DD=DIY+3
+1 IF $Y">Y>DIZ!'$Y">Y
Begin DoDot:1
+2 READ "'^' TO STOP: ",%Y:$GET(DTIME,300)
+3 IF '$TEST
SET DTOUT=1
KILL DDD
+4 WRITE $CHAR(13),$JUSTIFY("",15),$CHAR(13)
IF $DATA(DTOUT)
QUIT
+5 IF %Y[U
SET DTOUT=0
KILL DDD
+6 DO Y
WRITE ?3
End DoDot:1
+7 QUIT
+8 ;
W SET A4=$ORDER(DDH(A0,""))
IF A4=""
QUIT
IF DDH(A0,A4)=""
QUIT
+1 IF '$DATA(DDD)
WRITE !
+2 IF $GET(DDD)=3
IF A4["T"
KILL DDD
+3 ;
WR IF A4["X"
Begin DoDot:1
+1 NEW DDD,DIY,DDSXEC
+2 SET DDSXEC=DDH(A0,A4)
+3 NEW DDH
+4 IF $DATA(DDS)
NEW DDSID
SET DDSID=1
SET DDQ=$SELECT(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
+5 XECUTE DDSXEC
End DoDot:1
QUIT
+6 ;
+7 IF A4["Q"
Begin DoDot:1
+8 SET A4=DDH(A0,A4)
SET %=$PIECE(A4,U,1)
+9 IF $DATA(DDS)
DO ASK
QUIT
+10 WRITE $PIECE(A4,U,2)
+11 DO YN^DICN
End DoDot:1
QUIT
+12 ;
+13 IF A4["T"
Begin DoDot:1
+14 IF DDH(A0,A4)[$CHAR(0)
Begin DoDot:2
+15 SET DX=$LENGTH(DDH(A0,A4),$CHAR(0))-1
+16 XECUTE DDXY
+17 SET DDH(A0,A4)=$TRANSLATE(DDH(A0,A4),$CHAR(0),"")
End DoDot:2
+18 WRITE DDH(A0,A4)
End DoDot:1
QUIT
+19 ;
+20 IF '$DATA(DDS)
IF $GET(DDD)'["J"
IF A4'=+A4
QUIT
+21 IF $DATA(DDS)
IF $GET(DDD)=2!($GET(DDD)["J")
WRITE A0,?7
+22 ;
+23 WRITE DDH(A0,A4)
+24 IF $DATA(DDH("ID"))
Begin DoDot:1
+25 NEW DDD,DIY,DDSID
+26 SET DDSID=DDH("ID")
+27 IF $DATA(DDH("ID",1))#2
SET DDSID(1)=DDH("ID",1)
+28 NEW DDH
+29 IF $DATA(DDSID(1))#2
SET DDH("ID",1)=DDSID(1)
KILL DDSID(1)
+30 SET Y=A4
+31 IF $DATA(DDS)
SET DDQ=$SELECT(DY>(IOSL-1):IOSL-1,1:DY)_U_$X
+32 XECUTE DDSID
End DoDot:1
IF $DATA(DUOUT)
SET DIY=U
+33 QUIT
+34 ;
Y IF '$DATA(DISYS)
DO OS^DII
+1 SET $X=0
SET $Y=0
+2 SET DIZ=$SELECT($DATA(DILN)&'$DATA(DIR0):DILN,1:21)
+3 QUIT
+4 ;
Z DO Y
DO T
+1 QUIT
+2 ;
H IF '$DATA(A1)
SET A1="T"
+1 SET DDH=$GET(DDH)+1
SET DDH(DDH,A1)=DST
+2 KILL A1,DST
+3 DO SC
+4 QUIT
+5 ;#8053 Press 'RETURN' to continue...
+6 ;#8081 Choose |from-to| or '^'...
+7 ;#7001 Yes^No
