Return to DDSRSEL.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDSRSEL.m, revision 1.1.1.1

1.1       snw         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