DDS3 ;SFISC/MLH-COMMAND UTILS ;16FEB2005
;;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.
;
I $G(Y(0))]"","ECNRSPQ"[$E(Y(0)) D @$E(Y(0)) ;'Y' is carried over from the ^DIR read in DDSCOM
Q
;
S ;Save the form
D ^DDS4,R^DDSR
D:$D(DDSBR)#2 BR^DDS2
Q
;
R ;Repaint all pages on current screen
;Called after wp, mults, and deletions
G R^DDSR
;
E ;Exit
I DDSSC>1!'DDSCHG!$P(DDSSC(DDSSC),U,4) S DDACT="Q" Q
S DDM=1
S Y=1 G EX ;S Y=0 I $G(^XTV(8989.5,0))?1"PARAM".E S Y=$$GET^XPAR("ALL","DI SCREENMAN DON'T ASK SAVE") I Y=1 G EX ;**AVOID THE Y/N QUESTION
K DIR S DIR(0)="YO"
S DIR("A")=$$EZBLD^DIALOG(8075)
D BLD^DIALOG(9037,"","","DIR(""?"")")
S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^3^"_(IOSL-1)_"^0"
D ^DIR
K DIR,DIROUT,DIRUT
I Y=0!$D(DTOUT)!$D(DUOUT) D QT Q
I Y="" S DDACT="N" Q
I Y=1 D EX
Q
;
C ;Close
S DDACT="Q"
Q
;
N ;Next page
S:DDSNP]"" DDSPG=DDSNP,DDACT="NP"
Q
;
P ;Previous
D PP^DDS01 Q
;
Q ;
QT ;Exit, don't save
I $G(DDSDN)=1,DDO G ERR3
S DDACT="Q"
I DDSSC>1!$P(DDSSC(DDSSC),U,4) D MSG1 Q ;IT ALSO QUIT HERE IF $G(DDSSEL)
Q:'DDSCHG
D DEL^DDS6
S DX=0,DY=IOSL-1 X IOXY
W $P(DDGLCLR,DDGLDEL),$S($D(DTOUT):$$EZBLD^DIALOG(8076),1:"")_$$EZBLD^DIALOG(8077) H 1
Q
;
EX ;Exit, save
I $G(DDSDN)=1,DDO G ERR3
S DDACT="Q"
I DDSSC>1!$P(DDSSC(DDSSC),U,4) D MSG1 Q ;IT ALSO QUIT HERE IF $G(DDSSEL)
D ^DDS4 I 'Y S DDACT="N" D R D:$D(DDSBR)#2 BR^DDS2
Q
;
CL ;Close
I $G(DDSDN)=1,DDO G ERR3
G E
;
TO ;Time-out
I DDO,$G(DDSDN) S DDACT="N" G CURSOR^DDS01
I DDO S DDSOSV=DDO,DDO=0
E D E
Q
;
MSG1 ;Print closing page message
S DX=0,DY=IOSL-1 X IOXY
W $P(DDGLCLR,DDGLDEL)_"..." H 1
Q
;
ERR3 ;
D MSG^DDSMSG("Since navigation for the block is disabled, that key sequence is disabled.",1)
S DDACT="N"
Q
;
;#8075 Save changes before leaving form (Y/N)?
;#8076 Time out.
;#8077 Changes not saved!
;#9037 Enter 'Y' to save before exiting...(3 lines)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDS3 2235 printed Apr 09, 2024@21:51:58 Page 2
DDS3 ;SFISC/MLH-COMMAND UTILS ;16FEB2005
+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 ;'Y' is carried over from the ^DIR read in DDSCOM
IF $GET(Y(0))]""
IF "ECNRSPQ"[$EXTRACT(Y(0))
DO @$EXTRACT(Y(0))
+8 QUIT
+9 ;
S ;Save the form
+1 DO ^DDS4
DO R^DDSR
+2 if $DATA(DDSBR)#2
DO BR^DDS2
+3 QUIT
+4 ;
R ;Repaint all pages on current screen
+1 ;Called after wp, mults, and deletions
+2 GOTO R^DDSR
+3 ;
E ;Exit
+1 IF DDSSC>1!'DDSCHG!$PIECE(DDSSC(DDSSC),U,4)
SET DDACT="Q"
QUIT
+2 SET DDM=1
+3 ;S Y=0 I $G(^XTV(8989.5,0))?1"PARAM".E S Y=$$GET^XPAR("ALL","DI SCREENMAN DON'T ASK SAVE") I Y=1 G EX ;**AVOID THE Y/N QUESTION
SET Y=1
GOTO EX
+4 KILL DIR
SET DIR(0)="YO"
+5 SET DIR("A")=$$EZBLD^DIALOG(8075)
+6 DO BLD^DIALOG(9037,"","","DIR(""?"")")
+7 SET DIR0=IOSL-1_U_($LENGTH(DIR("A"))+1)_"^3^"_(IOSL-1)_"^0"
+8 DO ^DIR
+9 KILL DIR,DIROUT,DIRUT
+10 IF Y=0!$DATA(DTOUT)!$DATA(DUOUT)
DO QT
QUIT
+11 IF Y=""
SET DDACT="N"
QUIT
+12 IF Y=1
DO EX
+13 QUIT
+14 ;
C ;Close
+1 SET DDACT="Q"
+2 QUIT
+3 ;
N ;Next page
+1 if DDSNP]""
SET DDSPG=DDSNP
SET DDACT="NP"
+2 QUIT
+3 ;
P ;Previous
+1 DO PP^DDS01
QUIT
+2 ;
Q ;
QT ;Exit, don't save
+1 IF $GET(DDSDN)=1
IF DDO
GOTO ERR3
+2 SET DDACT="Q"
+3 ;IT ALSO QUIT HERE IF $G(DDSSEL)
IF DDSSC>1!$PIECE(DDSSC(DDSSC),U,4)
DO MSG1
QUIT
+4 if 'DDSCHG
QUIT
+5 DO DEL^DDS6
+6 SET DX=0
SET DY=IOSL-1
XECUTE IOXY
+7 WRITE $PIECE(DDGLCLR,DDGLDEL),$SELECT($DATA(DTOUT):$$EZBLD^DIALOG(8076),1:"")_$$EZBLD^DIALOG(8077)
HANG 1
+8 QUIT
+9 ;
EX ;Exit, save
+1 IF $GET(DDSDN)=1
IF DDO
GOTO ERR3
+2 SET DDACT="Q"
+3 ;IT ALSO QUIT HERE IF $G(DDSSEL)
IF DDSSC>1!$PIECE(DDSSC(DDSSC),U,4)
DO MSG1
QUIT
+4 DO ^DDS4
IF 'Y
SET DDACT="N"
DO R
if $DATA(DDSBR)#2
DO BR^DDS2
+5 QUIT
+6 ;
CL ;Close
+1 IF $GET(DDSDN)=1
IF DDO
GOTO ERR3
+2 GOTO E
+3 ;
TO ;Time-out
+1 IF DDO
IF $GET(DDSDN)
SET DDACT="N"
GOTO CURSOR^DDS01
+2 IF DDO
SET DDSOSV=DDO
SET DDO=0
+3 IF '$TEST
DO E
+4 QUIT
+5 ;
MSG1 ;Print closing page message
+1 SET DX=0
SET DY=IOSL-1
XECUTE IOXY
+2 WRITE $PIECE(DDGLCLR,DDGLDEL)_"..."
HANG 1
+3 QUIT
+4 ;
ERR3 ;
+1 DO MSG^DDSMSG("Since navigation for the block is disabled, that key sequence is disabled.",1)
+2 SET DDACT="N"
+3 QUIT
+4 ;
+5 ;#8075 Save changes before leaving form (Y/N)?
+6 ;#8076 Time out.
+7 ;#8077 Changes not saved!
+8 ;#9037 Enter 'Y' to save before exiting...(3 lines)
