DIR0H ;SFISC/MKO-HELP FOR SCREENS ;27JUN2004
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
N DIR0DX,DIR0DY,DIR0X,DIREPLIN
S DIR0DX=DX,DIR0DY=DY
S DIREPLIN=$P($$EZBLD^DIALOG(7002),U,$S($G(DIR0("REP")):2,1:1)) ;INSERT/REPLACE
W $P(DDGLVID,DDGLDEL,10)_$P(DDGLCLR,DDGLDEL,2)_$P(DDGLVID,DDGLDEL)
D HLP^DDGLIBH(9231,9233,"DDSH",IOSL-1)
I $D(DDS)#2 D
.D R^DDS3 I $D(DDO)#2 D
.. I 'DDO D CMD
.. E D
... K DDSH
EGP ... S DX=0,DY=IOSL-1 X DDXY W $$EZBLD^DIALOG(8000) ;**CCO/NI 'COMMAND:'
... S DX=IOM-35 X IOXY W $P(DDGLVID,DDGLDEL,10)_$$EZBLD^DIALOG(8074) ;** 'PF1-H'
E W $P(DDGLCLR,DDGLDEL,2)
;
S DX=IOM-$L(DIREPLIN)-1,DY=IOSL-1 X IOXY
W $P(DDGLVID,DDGLDEL,10)_$S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_DIREPLIN_$P(DDGLVID,DDGLDEL,10)
;
S DY=$P(DIR0,U,4),DX=$P(DIR0,U,5)
I $D(DIR("A"))=11 D
. S DIR0X=""
. F S DIR0X=$O(DIR("A",DIR0X)) Q:DIR0X="" D
.. X IOXY
.. W DIR("A",DIR0X)
.. S DY=DY+1
;
I $D(DIR("A"))#2 D
. X IOXY W DIR("A")
. I $D(DDS),DDO,DY=IOSL-1 W $P(DDGLCLR,DDGLDEL)
;
S DIR0X=$E(DIR0A,DIR0C-DIR0DX+DIR0S,DIR0C+DIR0F-DIR0DX-1)
S DX=DIR0S,DY=DIR0DY X IOXY W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_DIR0X,$E(DIR0SP,$L(DIR0X)+1,999)
S DX=DIR0DX X IOXY
Q
;
;
;
H ;MOUSE COMES HERE
N HELP,I
F I=0:0 S I=$O(^DI(.84,9234,2,I)) Q:'I I $G(^(I,0))'?." " S HELP($O(HELP(""),-1)+1)=^(0)
D HLP^DDSUTL(.HELP) Q
D:$D(DDS)#2 R^DDS3 ;REFRESH
Q
;
;
;
CMD ;
K DDH,DDQ
F DDH=1:1 Q:$D(DIR("?",DDH))[0 S DDH(DDH,"T")=DIR("?",DDH)
S:$D(DIR("?"))#2 DDH(DDH,"T")=DIR("?")
D LIST^DDSU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIR0H 1842 printed Dec 13, 2024@02:53:50 Page 2
DIR0H ;SFISC/MKO-HELP FOR SCREENS ;27JUN2004
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 NEW DIR0DX,DIR0DY,DIR0X,DIREPLIN
+8 SET DIR0DX=DX
SET DIR0DY=DY
+9 ;INSERT/REPLACE
SET DIREPLIN=$PIECE($$EZBLD^DIALOG(7002),U,$SELECT($GET(DIR0("REP")):2,1:1))
+10 WRITE $PIECE(DDGLVID,DDGLDEL,10)_$PIECE(DDGLCLR,DDGLDEL,2)_$PIECE(DDGLVID,DDGLDEL)
+11 DO HLP^DDGLIBH(9231,9233,"DDSH",IOSL-1)
+12 IF $DATA(DDS)#2
Begin DoDot:1
+13 DO R^DDS3
IF $DATA(DDO)#2
Begin DoDot:2
+14 IF 'DDO
DO CMD
+15 IF '$TEST
Begin DoDot:3
+16 KILL DDSH
EGP ;**CCO/NI 'COMMAND:'
SET DX=0
SET DY=IOSL-1
XECUTE DDXY
WRITE $$EZBLD^DIALOG(8000)
+1 ;** 'PF1-H'
SET DX=IOM-35
XECUTE IOXY
WRITE $PIECE(DDGLVID,DDGLDEL,10)_$$EZBLD^DIALOG(8074)
End DoDot:3
End DoDot:2
End DoDot:1
+2 IF '$TEST
WRITE $PIECE(DDGLCLR,DDGLDEL,2)
+3 ;
+4 SET DX=IOM-$LENGTH(DIREPLIN)-1
SET DY=IOSL-1
XECUTE IOXY
+5 WRITE $PIECE(DDGLVID,DDGLDEL,10)_$SELECT('$DATA(DDGLVAN):$PIECE(DDGLVID,DDGLDEL,6),1:"")_DIREPLIN_$PIECE(DDGLVID,DDGLDEL,10)
+6 ;
+7 SET DY=$PIECE(DIR0,U,4)
SET DX=$PIECE(DIR0,U,5)
+8 IF $DATA(DIR("A"))=11
Begin DoDot:1
+9 SET DIR0X=""
+10 FOR
SET DIR0X=$ORDER(DIR("A",DIR0X))
if DIR0X=""
QUIT
Begin DoDot:2
+11 XECUTE IOXY
+12 WRITE DIR("A",DIR0X)
+13 SET DY=DY+1
End DoDot:2
End DoDot:1
+14 ;
+15 IF $DATA(DIR("A"))#2
Begin DoDot:1
+16 XECUTE IOXY
WRITE DIR("A")
+17 IF $DATA(DDS)
IF DDO
IF DY=IOSL-1
WRITE $PIECE(DDGLCLR,DDGLDEL)
End DoDot:1
+18 ;
+19 SET DIR0X=$EXTRACT(DIR0A,DIR0C-DIR0DX+DIR0S,DIR0C+DIR0F-DIR0DX-1)
+20 SET DX=DIR0S
SET DY=DIR0DY
XECUTE IOXY
WRITE $SELECT('$DATA(DDGLVAN):$PIECE(DDGLVID,DDGLDEL,6),1:"")_DIR0X,$EXTRACT(DIR0SP,$LENGTH(DIR0X)+1,999)
+21 SET DX=DIR0DX
XECUTE IOXY
+22 QUIT
+23 ;
+24 ;
+25 ;
H ;MOUSE COMES HERE
+1 NEW HELP,I
+2 FOR I=0:0
SET I=$ORDER(^DI(.84,9234,2,I))
if 'I
QUIT
IF $GET(^(I,0))'?." "
SET HELP($ORDER(HELP(""),-1)+1)=^(0)
+3 DO HLP^DDSUTL(.HELP)
QUIT
+4 ;REFRESH
if $DATA(DDS)#2
DO R^DDS3
+5 QUIT
+6 ;
+7 ;
+8 ;
CMD ;
+1 KILL DDH,DDQ
+2 FOR DDH=1:1
if $DATA(DIR("?",DDH))[0
QUIT
SET DDH(DDH,"T")=DIR("?",DDH)
+3 if $DATA(DIR("?"))#2
SET DDH(DDH,"T")=DIR("?")
+4 DO LIST^DDSU
+5 QUIT
