DDSRSEL ;SFISC/MKO-RECORD SELECTION ;7JAN2004
;;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.
;
PG ;Called from:
; DDS01 when user presses SELECT
; FIRSTPG^DDS0 if no DA was passed in.
;
;Returns (if there is a record selection page and we're not in
;a multiple)
; DDSPG = Record selection page #
; DDACT = "NP"
; DDSSEL = 1 (undefined if no record selection page)
;
N P,P1 K DDSSEL
I $D(DDSSC),$P($G(DDSSC(DDSSC)),U,4) Q ;GFT
;
S P="",P1=$P($G(^DIST(.403,+DDS,21)),U)
I P1]"" D
. S P=$O(^DIST(.403,+DDS,40,"B",P1,""))
. I P]"",$D(^DIST(.403,+DDS,40,P,0))[0 S P=""
;
I P]"" D
. I $G(DDO),$G(DDSDN)=1 D
.. D ERR3^DDS3
. E S DDSPG=P,DDACT="NP",DDSSEL=1
Q
;
GDA ;Called from DDS
;After a record selection page is closed get the DA from
;the first field on the page.
N DDSANS,DDSREC,Y,PG
S DDSANS=""
GFT S PG=$P($G(^DIST(.403,+DDS,21)),U) G KILL:'PG N P S P=$O(^(40,"B",PG,0)) D:P I '$D(Y) G KILL
.F Y=0:0 S Y=$O(^DIST(.403,+DDS,40,P,40,Y)) Q:'Y I $G(^(Y,"COMP MUL"))]"" K Y Q
E S DDSREC=$$GET^DDSVALF(1,1,PG) ;ON THE OLD KIND OF LOOKUP PAGE, THERE IS 1 FIELD, 1 BLOCK
;
K DA,DDSDAORG
S DDSDA=DDSDASV,DDSDL=DDSDLSV
D BLDDA^DDS(DDSDA)
M DDSDAORG=DDSORGSV
;
I 'DDSREC,DA S DDSREC=DA
E I DDSREC,DDSREC'=DA D
. I DA D Q:DDSREC=DA
.. S DDSANS=$$ASKSAVE
.. I DDSANS="R" S DDSREC=DA
.. E I DDSANS="S" D
... D ^DDS4
... S:Y'=1 DDSREC=DA
. ;
. S DA=DDSREC
. D REC^DDS0(DDP,.DA)
. ;
. I $G(DIERR) D Q
.. D ERR^DDSMSG H 2
.. S DA=+$G(DDSDASV),DDACT="N"
.. D REC^DDS0(DDP,.DA)
. ;
. S DDACT="N"
. I DDSSC=1 D FRSTPG^DDS0(DDS,.DA,$G(DDSPAGE))
. D CLRDAT,UNLOCK
;
KILL K DDSSEL,DDSDASV,DDSDASV,DDSDLSV,DDSORGSV
Q
;
ASKSAVE() ;
;Ask user whether to save the previous record
N X,Y
D:DDM CLRMSG^DDS
S DDM=1
;
K DIR S DIR(0)="SM^S:SAVE;D:DISCARD;R:RETURN"
S DIR("A",1)=" NOTE: You must Save or Discard all edits to the"
S DIR("A",2)=" previous record before editing the next record."
S DIR("A",3)=" "
S DIR("A")="Save, Discard, or Return (S/D/R)"
S DIR("B")="SAVE"
;
S DIR("?",1)="Enter 'S' to save or 'D' to discard."
S DIR("?")="Enter 'R' or '^' to return to previous record."
;
S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^7^"_(IOSL-4)_"^0"
D ^DIR
I $D(DIRUT) S Y="R"
E I X="SAVE" S Y="S"
K DIR,DIROUT,DIRUT,DTOUT,DUOUT
Q Y
;
CLRDAT ;Clear all data values from @DDSREFT
N F,P
S P=0 F S P=$O(@DDSREFT@(P)) Q:'P K @DDSREFT@(P)
S F="F" F S F=$O(@DDSREFT@(F)) Q:$E(F)'="F" K @DDSREFT@(F)
Q
;
UNLOCK ;Unlock all records locked
Q:'$D(^TMP("DDS",$J,"LOCK"))
N I S I=""
F S I=$O(^TMP("DDS",$J,"LOCK",I)) Q:I="" D
. I I'=(DIE_DA_")") L -@I K ^TMP("DDS",$J,"LOCK",I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSRSEL 3008 printed Sep 23, 2025@20:19:37 Page 2
DDSRSEL ;SFISC/MKO-RECORD SELECTION ;7JAN2004
+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 ;
PG ;Called from:
+1 ; DDS01 when user presses SELECT
+2 ; FIRSTPG^DDS0 if no DA was passed in.
+3 ;
+4 ;Returns (if there is a record selection page and we're not in
+5 ;a multiple)
+6 ; DDSPG = Record selection page #
+7 ; DDACT = "NP"
+8 ; DDSSEL = 1 (undefined if no record selection page)
+9 ;
+10 NEW P,P1
KILL DDSSEL
+11 ;GFT
IF $DATA(DDSSC)
IF $PIECE($GET(DDSSC(DDSSC)),U,4)
QUIT
+12 ;
+13 SET P=""
SET P1=$PIECE($GET(^DIST(.403,+DDS,21)),U)
+14 IF P1]""
Begin DoDot:1
+15 SET P=$ORDER(^DIST(.403,+DDS,40,"B",P1,""))
+16 IF P]""
IF $DATA(^DIST(.403,+DDS,40,P,0))[0
SET P=""
End DoDot:1
+17 ;
+18 IF P]""
Begin DoDot:1
+19 IF $GET(DDO)
IF $GET(DDSDN)=1
Begin DoDot:2
+20 DO ERR3^DDS3
End DoDot:2
+21 IF '$TEST
SET DDSPG=P
SET DDACT="NP"
SET DDSSEL=1
End DoDot:1
+22 QUIT
+23 ;
GDA ;Called from DDS
+1 ;After a record selection page is closed get the DA from
+2 ;the first field on the page.
+3 NEW DDSANS,DDSREC,Y,PG
+4 SET DDSANS=""
GFT SET PG=$PIECE($GET(^DIST(.403,+DDS,21)),U)
if 'PG
GOTO KILL
NEW P
SET P=$ORDER(^(40,"B",PG,0))
if P
Begin DoDot:1
+1 FOR Y=0:0
SET Y=$ORDER(^DIST(.403,+DDS,40,P,40,Y))
if 'Y
QUIT
IF $GET(^(Y,"COMP MUL"))]""
KILL Y
QUIT
End DoDot:1
IF '$DATA(Y)
GOTO KILL
+2 ;ON THE OLD KIND OF LOOKUP PAGE, THERE IS 1 FIELD, 1 BLOCK
IF '$TEST
SET DDSREC=$$GET^DDSVALF(1,1,PG)
+3 ;
+4 KILL DA,DDSDAORG
+5 SET DDSDA=DDSDASV
SET DDSDL=DDSDLSV
+6 DO BLDDA^DDS(DDSDA)
+7 MERGE DDSDAORG=DDSORGSV
+8 ;
+9 IF 'DDSREC
IF DA
SET DDSREC=DA
+10 IF '$TEST
IF DDSREC
IF DDSREC'=DA
Begin DoDot:1
+11 IF DA
Begin DoDot:2
+12 SET DDSANS=$$ASKSAVE
+13 IF DDSANS="R"
SET DDSREC=DA
+14 IF '$TEST
IF DDSANS="S"
Begin DoDot:3
+15 DO ^DDS4
+16 if Y'=1
SET DDSREC=DA
End DoDot:3
End DoDot:2
if DDSREC=DA
QUIT
+17 ;
+18 SET DA=DDSREC
+19 DO REC^DDS0(DDP,.DA)
+20 ;
+21 IF $GET(DIERR)
Begin DoDot:2
+22 DO ERR^DDSMSG
HANG 2
+23 SET DA=+$GET(DDSDASV)
SET DDACT="N"
+24 DO REC^DDS0(DDP,.DA)
End DoDot:2
QUIT
+25 ;
+26 SET DDACT="N"
+27 IF DDSSC=1
DO FRSTPG^DDS0(DDS,.DA,$GET(DDSPAGE))
+28 DO CLRDAT
DO UNLOCK
End DoDot:1
+29 ;
KILL KILL DDSSEL,DDSDASV,DDSDASV,DDSDLSV,DDSORGSV
+1 QUIT
+2 ;
ASKSAVE() ;
+1 ;Ask user whether to save the previous record
+2 NEW X,Y
+3 if DDM
DO CLRMSG^DDS
+4 SET DDM=1
+5 ;
+6 KILL DIR
SET DIR(0)="SM^S:SAVE;D:DISCARD;R:RETURN"
+7 SET DIR("A",1)=" NOTE: You must Save or Discard all edits to the"
+8 SET DIR("A",2)=" previous record before editing the next record."
+9 SET DIR("A",3)=" "
+10 SET DIR("A")="Save, Discard, or Return (S/D/R)"
+11 SET DIR("B")="SAVE"
+12 ;
+13 SET DIR("?",1)="Enter 'S' to save or 'D' to discard."
+14 SET DIR("?")="Enter 'R' or '^' to return to previous record."
+15 ;
+16 SET DIR0=IOSL-1_U_($LENGTH(DIR("A"))+1)_"^7^"_(IOSL-4)_"^0"
+17 DO ^DIR
+18 IF $DATA(DIRUT)
SET Y="R"
+19 IF '$TEST
IF X="SAVE"
SET Y="S"
+20 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+21 QUIT Y
+22 ;
CLRDAT ;Clear all data values from @DDSREFT
+1 NEW F,P
+2 SET P=0
FOR
SET P=$ORDER(@DDSREFT@(P))
if 'P
QUIT
KILL @DDSREFT@(P)
+3 SET F="F"
FOR
SET F=$ORDER(@DDSREFT@(F))
if $EXTRACT(F)'="F"
QUIT
KILL @DDSREFT@(F)
+4 QUIT
+5 ;
UNLOCK ;Unlock all records locked
+1 if '$DATA(^TMP("DDS",$JOB,"LOCK"))
QUIT
+2 NEW I
SET I=""
+3 FOR
SET I=$ORDER(^TMP("DDS",$JOB,"LOCK",I))
if I=""
QUIT
Begin DoDot:1
+4 IF I'=(DIE_DA_")")
LOCK -@I
KILL ^TMP("DDS",$JOB,"LOCK",I)
End DoDot:1
+5 QUIT
