DDS ;SFISC/MLH,MKO - MAIN ROUTINE ;18MAR2017
;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
;;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.
;GFT;**1003,1004,1028,1043,1045,1055,1057**
;
N DIE,DX,DY,X,Y,DDSATOP
I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
;
D EN^DDS0(.DDSFILE,DR,.DA)
I $G(DIERR) D:$G(DDSPARM)'["E" G END^DDS0
. W !,$C(7)_$$EZBLD^DIALOG(3000)
. D MSG^DIALOG("BW")
. S DIMSG=""
;
N DR
X:$G(^DIST(.403,+DDS,11))'?."^" ^(11)
F D PG Q:DDACT="Q"
X:$G(^DIST(.403,+DDS,12))'?."^" ^(12)
;
D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
G END^DDS0
;
PROC ;Main loop -- do all the PAGES
F D PG Q:DDACT="Q"
Q
;
PG ;Load page
N DDSMX,DDSMY,DDSMOUSE,FND
S DDACT="N"
D EN^DDS1(DDSPG)
I $G(DIERR) D Q
. N P S P(1)=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U),P(2)=$P($G(^(1)),U)
. S:P(2)="" P(2)="unnamed"
. D BLD^DIALOG(3041,.P),ERR^DDSMSG H 2
. S DDACT="Q"
;
;Pre-action, save old and get next page
S DDSOPB=DDSPG
I $G(^DIST(.403,+DDS,40,DDSPG,11))'?."^" D PA(^(11)) Q:DDACT="NP"
S DDSNP=$$NP^DDS5(.Y) S:'Y DDSNP=""
;
;Get DDO and DDSBK
I $S($D(DDSBR)[0:1,1:$D(@DDSREFS@(DDSPG,$S(DDO:+DDSBK,1:0),DDO,"N"))[0) D
. S DDO=+$G(@DDSREFS@(DDSPG,"FIRST")),DDSBK=$P($G(^("FIRST")),",",2)
I 'DDSBK D Q
. D BLD^DIALOG(3055,"number "_$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U)_$S($G(^(1))]"":" ("_$P($G(^(1)),U)_")",1:""))
. D ERR^DDSMSG H 2
. S DDACT="Q"
;
;Get DDSPOP and update DDSSC array
;If we're going to another page
I '$D(DDSPGUP) D
. S DDSLN=^DIST(.403,+DDS,40,DDSPG,0),DDSPOP=$P(DDSLN,U,6)
. K:'DDSPOP DDSSC
SEL . I $D(DDSSEL) D
.. N P S P=$P($G(^DIST(.403,+DDS,21)),U) Q:P="" Q:$O(^(40,"B",P,""))'=DDSPG ;CONVERT PAGE TO ITS INTERNAL NUMBER
.. S DDSDASV=DDSDA,DDSDLSV=DDSDL
.. M DDSORGSV=DDSDAORG
.. K DA,@$$D0(DDSDL),DDSDAORG ;IF IT'S (REALLY) A RECORD SELECTION PAGE FORGET DA
.. S (DA,D0,DDSDAORG)="",DDSDA="0,",DDSDL=0
. I '$D(DDSSC("B",DDSPG)) D
.. S DDSSC=$G(DDSSC)+1,DDSSC(DDSSC)=DDSPG,DDSSC("B",DDSPG,DDSSC)="" ;Stack DDSSC
.. S:DDSPOP $P(DDSSC(DDSSC),U,2,3)=$P(DDSLN,U,3)_U_$P(DDSLN,U,7)
.. I $G(DDSSTK) S $P(DDSSC(DDSSC),U,4)=1 K DDSSTK
.. K DDSPOP
. E D
.. Q:$P($G(DDSSC(+$G(DDSSC))),U)=DDSPG
.. N I,J,S
.. S I=$O(DDSSC("B",DDSPG,"")),S=DDSSC(I) K DDSSC("B",DDSPG,I)
.. F J=I:1:DDSSC-1 D
... K DDSSC("B",$P(DDSSC(J+1),U),J)
... S DDSSC(J)=DDSSC(J+1),DDSSC("B",$P(DDSSC(J),U),J)=""
.. S DDSSC(DDSSC)=S,DDSSC("B",DDSPG,DDSSC)=""
;
;If we've moving up from a pop-up page
E K DDSPGUP
;
;Paint the page
D RP^DDSR(DDSSC(DDSSC),DDSSC=1)
;
P1 F D BLK Q:"^Q^NP^"[(U_DDACT_U)
;
;PAGE Post action, print any help
D:$G(^DIST(.403,+DDS,40,+DDSOPB,12))'?."^" PA(^(12))
D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
G:"^NB^N^"[(U_DDACT_U) P1
;
I DDACT="Q" D
. I '$P(DDSSC(DDSSC),U,4) D
.. I $G(DDSSEL) D GDA^DDSRSEL Q:'DA ;Process what came from the RECORD SELECTION PAGE now that we've returned from it
.. D:$G(DDSSC)>1 CLEAR^DDSBOX($P(DDSSC(DDSSC),U,2),$P(DDSSC(DDSSC),U,3))
.. S:DDSSC>1 DDSPG=$P(DDSSC(DDSSC-1),U),DDACT="N",DDSPGUP=1
. K DDSSC("B",$P(DDSSC(DDSSC),U),DDSSC),DDSSC(DDSSC) S DDSSC=DDSSC-1 ;Unstack DDSSC
Q
;
BLK S DDACT="N",DDSOSV=0
;
I $D(@DDSREFS@(DDSPG,DDSBK))[0 S DDACT="Q" Q
S DDSLN=@DDSREFS@(DDSPG,DDSBK)
;
S DDSDN=$P(DDSLN,U,4),DDSTP=$P(DDSLN,U,5)
S DDSREP=$P(DDSLN,U,7),DDSPTB=$P(DDSLN,U,8)
K:'DDSDN DDSDN K:DDSTP="e" DDSTP K:'DDSPTB DDSPTB K:DDSREP'>1 DDSREP
;
I $D(DDSPTB)!$D(DDSREP) N DDP,DDSDA,DIE D ;NEW WHEN WE GO INTO MULTIPLE!!
. S DDP=$P(DDSLN,U,3)
DIE . S DDSDA=$P(@DDSREFT@(DDSPG,DDSBK),U) I DDSDA'>0,$G(^(DDSBK,"COMP MUL"))="" S DIE=$G(DIE) Q ;Get Entry Number
. S DIE=@DDSREFT@(DDSPG,DDSBK,DDSDA,"GL")
;
I $D(DDSPTB) N DA,@$$D0(DDSDL),DDSDL D
. S DDSPTB=@DDSREFS@(DDSPG,DDSBK,"PTB")
. S DDSDL=$L(DDSDA,",")-2
. S (D0,DA)=+DDSDA
;
I $D(DDSREP) N DDSDL,DA D
. S DDSREP=$P(@DDSREFT@(DDSPG,DDSBK,DDSDA),U,2,999)
. S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),$P(DDSREP,U,4)),"0,"_DDSDA) ;2-arg $G -- go to empty line if none other specified
. S:'$P(DDSREP,U,7) DDSDA=$P(DDSDA,",")_","
. S DDSDL=$L(DDSDA,",")-2
I N @$$D0(DDSDL) D
. D BLDDA(DDSDA)
. S:'DA DDO=+$P(DDSREP,U,8) ;If this is a new subEntry, start at 1st editable field
;
PTB I $D(DDSPTB),'$D(DDSREP),'DDSDA,DDSDAORG D Q
. N DDSBK0
. S DDSBK0=DDSBK
. F S DDSBK=$$NB^DDS5(.Y) Q:DDSBK=DDSBK0!'Y!$G(@DDSREFT@(DDSPG,DDSBK))
. Q:Y
. I DDSNP]"" S DDSPG=DDSNP,DDACT="NP" Q
. S DDSPG=$$PP^DDS5(.Y) I Y S DDACT="NP" Q
. S DDACT="Q"
;
S $P(DDSOPB,U,2)=DDSBK
I $G(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,11))'?."^" D PA(^(11)) Q:DDACT="NP"
I $G(^DIST(.404,DDSBK,11))'?."^" D PA(^(11)) Q:DDACT="NP"
1 I $S($D(DDSBR)[0:1,1:$D(@DDSREFS@(DDSPG,$S(DDO:+DDSBK,1:0),DDO,"N"))[0) D
. S DDO=$P(@DDSREFS@(DDSPG,DDSBK),U,9) ;First field
K DDSLN
;
B1 D ^DDS01
;
I $G(^DIST(.403,+DDS,40,DDSPG,40,$P(DDSOPB,U,2),12))'?."^" D PA(^(12)) G:DDACT="N" B1
I $G(^DIST(.404,$P(DDSOPB,U,2),12))'?."^" D PA(^(12)) G:DDACT="N" B1
Q
;
BLDDA(DDSDA) ;
N I
S (DA,@("D"_DDSDL))=$P(DDSDA,",")
F I=1:1:DDSDL S (DA(I),@("D"_(DDSDL-I)))=$P(DDSDA,",",I+1)
Q
;
D0(DL) ;Given DL, return string D0,D1,...,Dn
N I,S
S S="" F I=0:1:DL S S=S_"D"_I_","
S:S?.E1"," S=$E(S,1,$L(S)-1)
Q S
;
CLRMSG ;FROM DDSU
I $G(DDSKM) H 2 K DDSKM ;GFT ** IF WE WERE KEEPING SOMETHING IN HELP AREA, HOLD UP 2 SECONDS ISB-0603-31054
K DDQ S DDSH=1,(DDM,DX)=0,DY=DDSHBX+1 X DDXY W $P(DDGLCLR,DDGLDEL,3) ;CLEAR WHOLE COMMAND AREA
N I F S I=$O(DDSMOUSE(DDSHBX)) Q:I+1=IOSL!'I K DDSMOUSE(I)
Q
;
PA(DDSPA) ;
N DDSBRORG S:$D(DDSBR)#2 DDSBRORG=DDSBR
K DDSBR X DDSPA ;PRE-ACTION OR POST-ACTION
I $D(DDSBR)[0 S:$D(DDSBRORG)#2 DDSBR=DDSBRORG Q
D BR^DDS2
Q
;
;
;
;
;
;
RESET ;Programmer entry point to reset terminal and cleanup
D INIT^DDGLIB0() D:$G(DIERR) MSG^DIALOG("BW")
W $P($G(DDGLVID),DDGLDEL,10)
K DDSPARM
S DDSREFT="^TMP(""DDS"",$J)"
D END^DDS0
G RESET^DDGF
;
RUN ;Run a form
G ^DDSRUN
CLONE ;Clone a form
G ^DDSCLONE
PRINT ;Print a form
G ^DDSPRNT
DFRM ;Delete a form
G ^DDSDFRM
DBLK ;Delete unused blocks
G ^DDSDBLK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDS 6404 printed Sep 23, 2025@20:19:02 Page 2
DDS ;SFISC/MLH,MKO - MAIN ROUTINE ;18MAR2017
+1 ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
+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 ;GFT;**1003,1004,1028,1043,1045,1055,1057**
+7 ;
+8 NEW DIE,DX,DY,X,Y,DDSATOP
+9 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
DO INIZE^DIEFU
+10 ;
+11 DO EN^DDS0(.DDSFILE,DR,.DA)
+12 IF $GET(DIERR)
if $GET(DDSPARM)'["E"
Begin DoDot:1
+13 WRITE !,$CHAR(7)_$$EZBLD^DIALOG(3000)
+14 DO MSG^DIALOG("BW")
+15 SET DIMSG=""
End DoDot:1
GOTO END^DDS0
+16 ;
+17 NEW DR
+18 if $GET(^DIST(.403,+DDS,11))'?."^"
XECUTE ^(11)
+19 FOR
DO PG
if DDACT="Q"
QUIT
+20 if $GET(^DIST(.403,+DDS,12))'?."^"
XECUTE ^(12)
+21 ;
+22 if $GET(@DDSREFT@("HLP"))>0
DO HLP^DDSMSG()
+23 GOTO END^DDS0
+24 ;
PROC ;Main loop -- do all the PAGES
+1 FOR
DO PG
if DDACT="Q"
QUIT
+2 QUIT
+3 ;
PG ;Load page
+1 NEW DDSMX,DDSMY,DDSMOUSE,FND
+2 SET DDACT="N"
+3 DO EN^DDS1(DDSPG)
+4 IF $GET(DIERR)
Begin DoDot:1
+5 NEW P
SET P(1)=$PIECE($GET(^DIST(.403,+DDS,40,DDSPG,0)),U)
SET P(2)=$PIECE($GET(^(1)),U)
+6 if P(2)=""
SET P(2)="unnamed"
+7 DO BLD^DIALOG(3041,.P)
DO ERR^DDSMSG
HANG 2
+8 SET DDACT="Q"
End DoDot:1
QUIT
+9 ;
+10 ;Pre-action, save old and get next page
+11 SET DDSOPB=DDSPG
+12 IF $GET(^DIST(.403,+DDS,40,DDSPG,11))'?."^"
DO PA(^(11))
if DDACT="NP"
QUIT
+13 SET DDSNP=$$NP^DDS5(.Y)
if 'Y
SET DDSNP=""
+14 ;
+15 ;Get DDO and DDSBK
+16 IF $SELECT($DATA(DDSBR)[0:1,1:$DATA(@DDSREFS@(DDSPG,$SELECT(DDO:+DDSBK,1:0),DDO,"N"))[0)
Begin DoDot:1
+17 SET DDO=+$GET(@DDSREFS@(DDSPG,"FIRST"))
SET DDSBK=$PIECE($GET(^("FIRST")),",",2)
End DoDot:1
+18 IF 'DDSBK
Begin DoDot:1
+19 DO BLD^DIALOG(3055,"number "_$PIECE($GET(^DIST(.403,+DDS,40,DDSPG,0)),U)_$SELECT($GET(^(1))]"":" ("_$PIECE($GET(^(1)),U)_")",1:""))
+20 DO ERR^DDSMSG
HANG 2
+21 SET DDACT="Q"
End DoDot:1
QUIT
+22 ;
+23 ;Get DDSPOP and update DDSSC array
+24 ;If we're going to another page
+25 IF '$DATA(DDSPGUP)
Begin DoDot:1
+26 SET DDSLN=^DIST(.403,+DDS,40,DDSPG,0)
SET DDSPOP=$PIECE(DDSLN,U,6)
+27 if 'DDSPOP
KILL DDSSC
SEL IF $DATA(DDSSEL)
Begin DoDot:2
+1 ;CONVERT PAGE TO ITS INTERNAL NUMBER
NEW P
SET P=$PIECE($GET(^DIST(.403,+DDS,21)),U)
if P=""
QUIT
if $ORDER(^(40,"B",P,""))'=DDSPG
QUIT
+2 SET DDSDASV=DDSDA
SET DDSDLSV=DDSDL
+3 MERGE DDSORGSV=DDSDAORG
+4 ;IF IT'S (REALLY) A RECORD SELECTION PAGE FORGET DA
KILL DA,@$$D0(DDSDL),DDSDAORG
+5 SET (DA,D0,DDSDAORG)=""
SET DDSDA="0,"
SET DDSDL=0
End DoDot:2
+6 IF '$DATA(DDSSC("B",DDSPG))
Begin DoDot:2
+7 ;Stack DDSSC
SET DDSSC=$GET(DDSSC)+1
SET DDSSC(DDSSC)=DDSPG
SET DDSSC("B",DDSPG,DDSSC)=""
+8 if DDSPOP
SET $PIECE(DDSSC(DDSSC),U,2,3)=$PIECE(DDSLN,U,3)_U_$PIECE(DDSLN,U,7)
+9 IF $GET(DDSSTK)
SET $PIECE(DDSSC(DDSSC),U,4)=1
KILL DDSSTK
+10 KILL DDSPOP
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 if $PIECE($GET(DDSSC(+$GET(DDSSC))),U)=DDSPG
QUIT
+13 NEW I,J,S
+14 SET I=$ORDER(DDSSC("B",DDSPG,""))
SET S=DDSSC(I)
KILL DDSSC("B",DDSPG,I)
+15 FOR J=I:1:DDSSC-1
Begin DoDot:3
+16 KILL DDSSC("B",$PIECE(DDSSC(J+1),U),J)
+17 SET DDSSC(J)=DDSSC(J+1)
SET DDSSC("B",$PIECE(DDSSC(J),U),J)=""
End DoDot:3
+18 SET DDSSC(DDSSC)=S
SET DDSSC("B",DDSPG,DDSSC)=""
End DoDot:2
End DoDot:1
+19 ;
+20 ;If we've moving up from a pop-up page
+21 IF '$TEST
KILL DDSPGUP
+22 ;
+23 ;Paint the page
+24 DO RP^DDSR(DDSSC(DDSSC),DDSSC=1)
+25 ;
P1 FOR
DO BLK
if "^Q^NP^"[(U_DDACT_U)
QUIT
+1 ;
+2 ;PAGE Post action, print any help
+3 if $GET(^DIST(.403,+DDS,40,+DDSOPB,12))'?."^"
DO PA(^(12))
+4 if $GET(@DDSREFT@("HLP"))>0
DO HLP^DDSMSG()
+5 if "^NB^N^"[(U_DDACT_U)
GOTO P1
+6 ;
+7 IF DDACT="Q"
Begin DoDot:1
+8 IF '$PIECE(DDSSC(DDSSC),U,4)
Begin DoDot:2
+9 ;Process what came from the RECORD SELECTION PAGE now that we've returned from it
IF $GET(DDSSEL)
DO GDA^DDSRSEL
if 'DA
QUIT
+10 if $GET(DDSSC)>1
DO CLEAR^DDSBOX($PIECE(DDSSC(DDSSC),U,2),$PIECE(DDSSC(DDSSC),U,3))
+11 if DDSSC>1
SET DDSPG=$PIECE(DDSSC(DDSSC-1),U)
SET DDACT="N"
SET DDSPGUP=1
End DoDot:2
+12 ;Unstack DDSSC
KILL DDSSC("B",$PIECE(DDSSC(DDSSC),U),DDSSC),DDSSC(DDSSC)
SET DDSSC=DDSSC-1
End DoDot:1
+13 QUIT
+14 ;
BLK SET DDACT="N"
SET DDSOSV=0
+1 ;
+2 IF $DATA(@DDSREFS@(DDSPG,DDSBK))[0
SET DDACT="Q"
QUIT
+3 SET DDSLN=@DDSREFS@(DDSPG,DDSBK)
+4 ;
+5 SET DDSDN=$PIECE(DDSLN,U,4)
SET DDSTP=$PIECE(DDSLN,U,5)
+6 SET DDSREP=$PIECE(DDSLN,U,7)
SET DDSPTB=$PIECE(DDSLN,U,8)
+7 if 'DDSDN
KILL DDSDN
if DDSTP="e"
KILL DDSTP
if 'DDSPTB
KILL DDSPTB
if DDSREP'>1
KILL DDSREP
+8 ;
+9 ;NEW WHEN WE GO INTO MULTIPLE!!
IF $DATA(DDSPTB)!$DATA(DDSREP)
NEW DDP,DDSDA,DIE
Begin DoDot:1
+10 SET DDP=$PIECE(DDSLN,U,3)
DIE ;Get Entry Number
SET DDSDA=$PIECE(@DDSREFT@(DDSPG,DDSBK),U)
IF DDSDA'>0
IF $GET(^(DDSBK,"COMP MUL"))=""
SET DIE=$GET(DIE)
QUIT
+1 SET DIE=@DDSREFT@(DDSPG,DDSBK,DDSDA,"GL")
End DoDot:1
+2 ;
+3 IF $DATA(DDSPTB)
NEW DA,@$$D0(DDSDL),DDSDL
Begin DoDot:1
+4 SET DDSPTB=@DDSREFS@(DDSPG,DDSBK,"PTB")
+5 SET DDSDL=$LENGTH(DDSDA,",")-2
+6 SET (D0,DA)=+DDSDA
End DoDot:1
+7 ;
+8 IF $DATA(DDSREP)
NEW DDSDL,DA
Begin DoDot:1
+9 SET DDSREP=$PIECE(@DDSREFT@(DDSPG,DDSBK,DDSDA),U,2,999)
+10 ;2-arg $G -- go to empty line if none other specified
SET DDSDA=$GET(@DDSREFT@(DDSPG,DDSBK,$PIECE(DDSREP,U),$PIECE(DDSREP,U,4)),"0,"_DDSDA)
+11 if '$PIECE(DDSREP,U,7)
SET DDSDA=$PIECE(DDSDA,",")_","
+12 SET DDSDL=$LENGTH(DDSDA,",")-2
End DoDot:1
+13 IF $TEST
NEW @$$D0(DDSDL)
Begin DoDot:1
+14 DO BLDDA(DDSDA)
+15 ;If this is a new subEntry, start at 1st editable field
if 'DA
SET DDO=+$PIECE(DDSREP,U,8)
End DoDot:1
+16 ;
PTB IF $DATA(DDSPTB)
IF '$DATA(DDSREP)
IF 'DDSDA
IF DDSDAORG
Begin DoDot:1
+1 NEW DDSBK0
+2 SET DDSBK0=DDSBK
+3 FOR
SET DDSBK=$$NB^DDS5(.Y)
if DDSBK=DDSBK0!'Y!$GET(@DDSREFT@(DDSPG,DDSBK))
QUIT
+4 if Y
QUIT
+5 IF DDSNP]""
SET DDSPG=DDSNP
SET DDACT="NP"
QUIT
+6 SET DDSPG=$$PP^DDS5(.Y)
IF Y
SET DDACT="NP"
QUIT
+7 SET DDACT="Q"
End DoDot:1
QUIT
+8 ;
+9 SET $PIECE(DDSOPB,U,2)=DDSBK
+10 IF $GET(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,11))'?."^"
DO PA(^(11))
if DDACT="NP"
QUIT
+11 IF $GET(^DIST(.404,DDSBK,11))'?."^"
DO PA(^(11))
if DDACT="NP"
QUIT
1 IF $SELECT($DATA(DDSBR)[0:1,1:$DATA(@DDSREFS@(DDSPG,$SELECT(DDO:+DDSBK,1:0),DDO,"N"))[0)
Begin DoDot:1
+1 ;First field
SET DDO=$PIECE(@DDSREFS@(DDSPG,DDSBK),U,9)
End DoDot:1
+2 KILL DDSLN
+3 ;
B1 DO ^DDS01
+1 ;
+2 IF $GET(^DIST(.403,+DDS,40,DDSPG,40,$PIECE(DDSOPB,U,2),12))'?."^"
DO PA(^(12))
if DDACT="N"
GOTO B1
+3 IF $GET(^DIST(.404,$PIECE(DDSOPB,U,2),12))'?."^"
DO PA(^(12))
if DDACT="N"
GOTO B1
+4 QUIT
+5 ;
BLDDA(DDSDA) ;
+1 NEW I
+2 SET (DA,@("D"_DDSDL))=$PIECE(DDSDA,",")
+3 FOR I=1:1:DDSDL
SET (DA(I),@("D"_(DDSDL-I)))=$PIECE(DDSDA,",",I+1)
+4 QUIT
+5 ;
D0(DL) ;Given DL, return string D0,D1,...,Dn
+1 NEW I,S
+2 SET S=""
FOR I=0:1:DL
SET S=S_"D"_I_","
+3 if S?.E1","
SET S=$EXTRACT(S,1,$LENGTH(S)-1)
+4 QUIT S
+5 ;
CLRMSG ;FROM DDSU
+1 ;GFT ** IF WE WERE KEEPING SOMETHING IN HELP AREA, HOLD UP 2 SECONDS ISB-0603-31054
IF $GET(DDSKM)
HANG 2
KILL DDSKM
+2 ;CLEAR WHOLE COMMAND AREA
KILL DDQ
SET DDSH=1
SET (DDM,DX)=0
SET DY=DDSHBX+1
XECUTE DDXY
WRITE $PIECE(DDGLCLR,DDGLDEL,3)
+3 NEW I
FOR
SET I=$ORDER(DDSMOUSE(DDSHBX))
if I+1=IOSL!'I
QUIT
KILL DDSMOUSE(I)
+4 QUIT
+5 ;
PA(DDSPA) ;
+1 NEW DDSBRORG
if $DATA(DDSBR)#2
SET DDSBRORG=DDSBR
+2 ;PRE-ACTION OR POST-ACTION
KILL DDSBR
XECUTE DDSPA
+3 IF $DATA(DDSBR)[0
if $DATA(DDSBRORG)#2
SET DDSBR=DDSBRORG
QUIT
+4 DO BR^DDS2
+5 QUIT
+6 ;
+7 ;
+8 ;
+9 ;
+10 ;
+11 ;
RESET ;Programmer entry point to reset terminal and cleanup
+1 DO INIT^DDGLIB0()
if $GET(DIERR)
DO MSG^DIALOG("BW")
+2 WRITE $PIECE($GET(DDGLVID),DDGLDEL,10)
+3 KILL DDSPARM
+4 SET DDSREFT="^TMP(""DDS"",$J)"
+5 DO END^DDS0
+6 GOTO RESET^DDGF
+7 ;
RUN ;Run a form
+1 GOTO ^DDSRUN
CLONE ;Clone a form
+1 GOTO ^DDSCLONE
PRINT ;Print a form
+1 GOTO ^DDSPRNT
DFRM ;Delete a form
+1 GOTO ^DDSDFRM
DBLK ;Delete unused blocks
+1 GOTO ^DDSDBLK
