File:  [Coherent Logic Development] / freem_fileman / USER / DDSRSEL.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDSRSEL	;SFISC/MKO-RECORD SELECTION ;12:45 PM  11 Sep 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: PG	;Called from:
    6: 	;  DDS01 when user presses SELECT
    7: 	;  FIRSTPG^DDS0 if no DA was passed in.
    8: 	;
    9: 	;Returns (if there is a record selection page and we're not in
   10: 	;a multiple)
   11: 	; DDSPG  = Record selection page #
   12: 	; DDACT  = "NP"
   13: 	; DDSSEL = 1 (undefined if no record selection page)
   14: 	;
   15: 	N P,P1 K DDSSEL
   16: 	I $D(DDSSC),$P(DDSSC(DDSSC),U,4) Q
   17: 	;
   18: 	S P="",P1=$P($G(^DIST(.403,+DDS,21)),U)
   19: 	I P1]"" D
   20: 	. S P=$O(^DIST(.403,+DDS,40,"B",P1,""))
   21: 	. I P]"",$D(^DIST(.403,+DDS,40,P,0))[0 S P=""
   22: 	;
   23: 	I P]"" D
   24: 	. I DDO,$G(DDSDN)=1 D
   25: 	.. D ERR3^DDS3
   26: 	. E  S DDSPG=P,DDACT="NP",DDSSEL=1
   27: 	Q
   28: 	;
   29: GDA	;Called from DDS
   30: 	;After a record selection page is closed get the DA from
   31: 	;the first field on the page.
   32: 	N DDSANS,DDSDASV,DDSREC,Y
   33: 	S DDSDASV=DA,DDSANS=""
   34: 	S DDSREC=$$GET^DDSVALF(1,1,$P(^DIST(.403,+DDS,21),U))
   35: 	;
   36: 	I DDSREC]"",DA'=DDSREC D
   37: 	. S DA=DDSREC
   38: 	. D REC^DDS0(DDP,.DA)
   39: 	. I $G(DIERR) D ERR^DDSMSG H 2 S DA=DDSDASV Q
   40: 	. I DDSDASV D
   41: 	.. S DDSANS=$$ASKSAVE Q:DDSANS=U  D:DDSANS="S" S^DDS3
   42: 	.. D CLRDAT,UNLOCK
   43: 	. I DDSANS=U S DA=DDSDASV Q
   44: 	. I DDSSC=1 D FRSTPG^DDS0(DDS,.DA,$G(DDSPAGE)) S DDACT="N"
   45: 	K DDSSEL
   46: 	Q
   47: 	;
   48: ASKSAVE()	;
   49: 	;Ask user whether to save the previous record
   50: 	;Returns U:abort, 1:save, 2:discard
   51: 	N X,Y D:DDM CLRMSG^DDS
   52: 	S DDM=1
   53: 	;
   54: 	K DIR S DIR(0)="SM^S:SAVE;D:DISCARD;R:RETURN"
   55: 	S DIR("A",1)="  NOTE:  YOU MUST SAVE OR DISCARD ALL EDITS TO THE"
   56: 	S DIR("A",2)="         PREVIOUS RECORD BEFORE EDITING THE NEXT RECORD."
   57: 	S DIR("A")="Save, Discard, or Return to previous record (S/D/R)"
   58: 	S DIR("B")="SAVE"
   59: 	;
   60: 	S DIR("?",1)="Enter 'S' to save or 'D' to discard."
   61: 	S DIR("?")="Enter 'R' or '^' to return to previous record."
   62: 	;
   63: 	S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^7^"_(IOSL-3)_"^0"
   64: 	D ^DIR
   65: 	I $D(DIRUT) S Y=U
   66: 	E  S:X="SAVE" Y="S",Y(0)="SAVE"
   67: 	K DIR,DIROUT,DIRUT,DTOUT,DUOUT
   68: 	Q Y
   69: 	;
   70: CLRDAT	;Clear all data values from @DDSREFT
   71: 	N F,P
   72: 	S P=0 F  S P=$O(@DDSREFT@(P)) Q:'P  K @DDSREFT@(P)
   73: 	S F="F" F  S F=$O(@DDSREFT@(F)) Q:$E(F)'="F"  K @DDSREFT@(F)
   74: 	Q
   75: 	;
   76: UNLOCK	;Unlock all records locked
   77: 	Q:'$D(^TMP("DDS",$J,"LOCK"))
   78: 	N I S I=""
   79: 	F  S I=$O(^TMP("DDS",$J,"LOCK",I)) Q:I=""  D
   80: 	. I I'=(DIE_DA_")") L -@I K ^TMP("DDS",$J,"LOCK",I)
   81: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>