Return to DDSRSEL.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDSRSEL.m, revision 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