DDS3.m

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 ---DDS3   2235     printed  Mar 13, 2025@21:47:49                                                                                                                                                                                                        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)