Return to DDSVALM.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DDSVALM.m, revision 1.1

1.1     ! snw         1: DDSVALM        ;SFISC/MKO-PUT FOR MULTIPLES (SELECT PROMPT) ;10:45 AM  9 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: MULT   ;Put multiple or wp field
        !             6:        N DDSVDIC,DDSVDV,DDSVND,DDSVPC,DDSVSUB
        !             7:        S DDSVPC=$P(DDSV0,U,4),DDSVND=$P(DDSVPC,";"),DDSVPC=$P(DDSVPC,";",2)
        !             8:        S DDSVSUB=+DDSV02 Q:$D(^DD(DDSVSUB,.01,0))[0
        !             9:        S DDSVDV=DDSVSUB_$P(^DD(DDSVSUB,.01,0),U,2),X=$P(^(0),U,3)
        !            10:        S DDSVDIC=DIE_DA_","""_DDSVND_""","
        !            11:        ;
        !            12:        I DDSVDV["W" D PUTWP
        !            13:        I DDSVDV'["W" D PUTMULT
        !            14:        Q
        !            15:        ;
        !            16: PUTMULT        ;Put for multiples
        !            17:        N DDSVRN
        !            18:        S DDSVRN=$S(DDSVAL="FIRST":$O(@(DDSVDIC_"0)")),DDSVAL="LAST":$O(@(DDSVDIC_""" "")"),-1),1:+$G(DDSVAL))
        !            19:        ;
        !            20:        K Y S Y="",Y(0)=""
        !            21:        I DDSVRN>0,$D(@(DDSVDIC_+DDSVRN_",0)"))#2 S Y(0)=$P(^(0),U) D
        !            22:        . I DDSVDV["O"!(DDSVDV["P")!(DDSVDV["V")!(DDSVDV["D")!(DDSVDV["S") D
        !            23:        .. S Y(0)=$$EXTERNAL^DILFD(DDSVSUB,.01,"",DDSVRN)
        !            24:        . S Y=DDSVRN
        !            25:        ;
        !            26:        S:'$D(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD,"M")) ^("M")=1_DDSVDIC_U_DDSVSUB
        !            27:        D UPDATE^DDSVAL(DDP,DDSVDA,.DA,DDSFLD,DDSPG,.Y)
        !            28:        Q
        !            29:        ;
        !            30: PUTWP  ;File wp field from @DDSVAL into @DDSREFT
        !            31:        N DDSTMP
        !            32:        S DDSTMP=$NA(@DDSREFT@("F"_DDP,DDSDA))
        !            33:        ;
        !            34:        I DDSVAL]"",$D(@DDSVAL) D  Q:$G(DIERR)
        !            35:        . D PUTWP^DIEFW($E("A",DDSPARM["A"),DDSVAL,$NA(@DDSTMP@(DDSFLD,"D")))
        !            36:        E  K @DDSTMP@(DDSFLD,"D")
        !            37:        ;
        !            38:        S:$D(@DDSTMP@(DDSFLD,"M"))[0 ^("M")="0"_DDSVDIC_U_DDSVSUB
        !            39:        S:$D(@DDSTMP@("GL"))[0 ^("GL")=DIE
        !            40:        S (DDSCHG,@DDSTMP@(DDSFLD,"F"))=3
        !            41:        Q
        !            42:        ;
        !            43: GETWP  ;Merge wp field into ^TMP, return root in DDSANS
        !            44:        N DDSGL
        !            45:        S DDSGL=DIE_DA_","""_DDSVND_""","
        !            46:        S DDSANS=$NA(^TMP("DDSWP",$J,DDP,DDSDA,DDSFLD))
        !            47:        ;
        !            48:        K @DDSANS
        !            49:        M:$D(@(DDSGL_"0)"))#2 @DDSANS=@($E(DDSGL,1,$L(DDSGL)-1)_")")
        !            50:        Q
        !            51:        ;
        !            52: REL(DDP,DA,DDSFLD,DDSPARM)     ;Relational syntax
        !            53:        N DDSCD,DDSI,X
        !            54:        D DD^DDSPTR(DDP,DDSFLD,"",.DDSCD,"",DDSPARM["I"+1)
        !            55:        F DDSI=1:1:DDSCD X DDSCD(DDSI)
        !            56:        Q X
        !            57:        ;
        !            58: ERR(DDSVEP)    ;Print error messages
        !            59:        Q:'$G(DIERR)
        !            60:        I '$D(DDS) D MSG^DIALOG("BW") Q
        !            61:        N DDSVMSG
        !            62:        S DDSER=DIERR
        !            63:        D BLD^DIALOG(3031,DDSVEP,"","DDSVMSG")
        !            64:        D MSG^DDSMSG(DDSVMSG(1)),ERR^DDSMSG
        !            65:        Q