- 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 Mar 13, 2025@21:58:41 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
