Return to DDSUTL.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDSUTL.m, revision 1.1

1.1     ! snw         1: DDSUTL ;SFISC/MKO-PROGRAMMER UTILITIES ;03:36 PM  7 Dec 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: MSG(TXT)       ;
        !             6:        ;Data validation messages
        !             7:        D PROC(.TXT,$NA(@DDSREFT@("MSG")))
        !             8:        Q
        !             9:        ;
        !            10: HLP(TXT)       ;
        !            11:        ;Help box messages
        !            12:        D PROC(.TXT,$NA(@DDSREFT@("HLP")))
        !            13:        Q
        !            14: PROC(TXT,GLB)  ;
        !            15:        ;Put text into global
        !            16:        N CNT,I
        !            17:        S CNT=$G(@GLB)
        !            18:        I $D(TXT)<9 S CNT=CNT+1,@GLB@(CNT)=TXT
        !            19:        E  S I="" F CNT=CNT:1 S I=$O(TXT(I)) Q:I=""  S @GLB@(CNT+1)=TXT(I)
        !            20:        S @GLB=CNT
        !            21:        Q
        !            22:        ;
        !            23: REFRESH        ;Refresh the screen
        !            24:        G R^DDSR
        !            25:        ;
        !            26: MLOAD(DDSIEN)  ;Load subrecords for current multiple
        !            27:        G MLOAD^DDSM1
        !            28:        ;
        !            29: MDEL(DDSIEN)   ;Delete subrecords for current multiple
        !            30:        G MDEL^DDSM1
        !            31:        ;
        !            32: UNED(DDSF,DDSB,DDSP,DDSVAL,DDSUDA)     ;Change DISABLE EDITING attribute
        !            33:        S:$D(DDSVAL)[0 DDSVAL=""
        !            34:        D SETATT(4)
        !            35:        Q
        !            36:        ;
        !            37: REQ(DDSF,DDSB,DDSP,DDSVAL,DDSUDA)      ;Change REQUIRED attribute
        !            38:        S:$D(DDSVAL)[0 DDSVAL=""
        !            39:        D SETATT(1)
        !            40:        Q
        !            41:        ;
        !            42:        ;
        !            43: SETATT(DDSUPC) ;Set attribute node, piece DDSUPC
        !            44:        N DDSOVAL,DDSUDDP,DDSUFLD,DDSUTP
        !            45:        I $D(DDSPG)[0 N DDSPG S DDSPG=""
        !            46:        I $D(DDSBK)[0 N DDSBK S DDSBK=""
        !            47:        S DDSP=$$GETFLD^DDSLIB(DDSF,$G(DDSB),$G(DDSP),+DDS,DDSPG,DDSBK)
        !            48:        I $G(DIERR) D ERR^DDSMSG Q
        !            49:        ;
        !            50:        S DDSF=$P(DDSP,","),DDSB=$P(DDSP,",",2),DDSP=$P(DDSP,",",3)
        !            51:        ;
        !            52:        S DDSUDDP=+$P($G(^DIST(.404,DDSB,0)),U,2)
        !            53:        I DDSUDDP,$G(DDSUDA)]"" N DDSDA S DDSDA=DDSUDA
        !            54:        E  I DDSUDDP,DDSB'=DDSBK N DDSDA D GL^DDS10(DDSUDDP,.DDSDAORG,"","",.DDSDA)
        !            55:        ;
        !            56:        S DDSUTP=$P($G(^DIST(.404,DDSB,40,DDSF,0)),U,3)
        !            57:        I DDSUTP=2 D
        !            58:        . S DDSUFLD=DDSF_","_DDSB
        !            59:        . S DDSUDDP=0
        !            60:        E  I DDSUTP=3 D  Q:'DDSUFLD
        !            61:        . S DDSUFLD=$P($G(^DIST(.404,DDSB,40,DDSF,1)),U)
        !            62:        E  Q
        !            63:        ;
        !            64:        S DDSOVAL=$P($G(@DDSREFT@("F"_DDSUDDP,DDSDA,DDSUFLD,"A")),U,DDSUPC)
        !            65:        Q:DDSVAL=DDSOVAL
        !            66:        S $P(@DDSREFT@("F"_DDSUDDP,DDSDA,DDSUFLD,"A"),U,DDSUPC)=DDSVAL
        !            67:        Q
        !            68:        ;
        !            69: ADD(DDSFIL,X,DA,DINUM,DDSDIC0,DDSDR,DDSL)      ;
        !            70:        ;Add an entry as part of a transaction
        !            71:        ;DDSL=1 means don't lock
        !            72:        ;
        !            73:        N %,%W,%Y,C,D0,DD,DO,DI,DIC,DIE,DQ,DR
        !            74:        N DDSDA,DDSDIC,DDSFD,DDSREQ,DDSUP,I
        !            75:        K DIERR,^TMP("DIERR",$J)
        !            76:        K:'$G(DINUM) DINUM
        !            77:        S:$G(DDSDIC0)="" DDSDIC0="L"
        !            78:        S DIC(0)=DDSDIC0,Y=-1
        !            79:        S:$G(DDSDR)]"" DIC("DR")=DDSDR
        !            80:        S DIC=$$ROOT^DILFD(DDSFIL,.DA),DDSDIC=$$CREF^DIQGU(DIC)
        !            81:        ;
        !            82:        I $D(@DDSDIC@(0))[0 D  Q:$G(DIC("P"))=""
        !            83:        . S DDSUP=$G(^DD(DDSFIL,0,"UP")) Q:'DDSUP
        !            84:        . S DDSFD=$O(^DD(DDSUP,"SB",DDSFIL,"")) Q:'DDSFD
        !            85:        . S DIC("P")=$P($G(^DD(DDSUP,DDSFD,0)),U,2)
        !            86:        ;
        !            87:        I DDSDIC0'["E",$$REQID(DDSFIL,.DDSREQ) D  Q:$G(DIERR)
        !            88:        . N F
        !            89:        . S F=""
        !            90:        . F  S F=$O(DDSREQ(F)) Q:'F  I $G(DIC("DR"))'[(F_"///") D BLD^DIALOG(3031,"ADD^DDSUTL") Q
        !            91:        ;
        !            92:        D FILE^DICN K DTOUT,DUOUT Q:Y=-1!'$D(DDS)
        !            93:        ;
        !            94:        I '$G(DDSL) D
        !            95:        . N I,L,R
        !            96:        . S L=1,R=DIC_DA_","
        !            97:        . F I=$L(R,",")-1:-1:1 I $D(^TMP("DDS",$J,"LOCK",$P(R,",",1,I)_")"))#2 S L=0 Q
        !            98:        . I L,$D(^TMP("DDS",$J,"LOCK",$P(R,"(")))#2 S L=0
        !            99:        . I L L +@(DIC_+Y_")"):0 S ^TMP("DDS",$J,"LOCK",DIC_+Y_")")=""
        !           100:        ;
        !           101:        S DDSDA=+Y_","
        !           102:        F I=1:1 Q:$D(DA(I))[0  S DDSDA=DDSDA_DA(I)_","
        !           103:        S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIC
        !           104:        Q
        !           105:        ;
        !           106: REQID(FIL,REQ) ;
        !           107:        ;Get list of required identifiers into DDSREQ
        !           108:        N F
        !           109:        K REQ
        !           110:        S F="" F  S F=$O(^DD(FIL,0,"ID",F)) Q:F'=+$P(F,"E")  D
        !           111:        . S:$P($G(^DD(FIL,F,0)),U,2)["R" REQ(F)=""
        !           112:        Q $D(REQ)>0
        !           113:        ;
        !           114: DDSDA(DA,DL,DDSDA)     ;Determine DDSDA
        !           115:        ;
        !           116:        N I
        !           117:        I DA="" S DDSDA="" Q
        !           118:        S DDSDA=DA_"," F I=1:1:DL S DDSDA=DDSDA_DA(I)_","
        !           119:        Q