Return to DICA1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICA1.m, revision 1.1

1.1     ! snw         1: DICA1  ;SEA/TOAD-VA FileMan: Updater, Pre-Processor ;11/15/94  16:37 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        
        !             5: CHECK(DIFLAGS,DIFDA,DINUMS,DIRULE,DIOK)        
        !             6:        ; ENTRY POINT--check out the FDA
        !             7:        ; subroutine, DIFLAGS passed by value
        !             8:        N DIC,DIEN,DIFILE,DIFLD,DIN,DINODE,DINT,DINUM,DIOP
        !             9:        N DIOUT1,DIOUT2,DIOUT3,DIRID,DIRIGHT,DISEQ,DITYPE,DIVAL
        !            10: FILES  
        !            11:        S DIFILE=0,DIOUT1=0 F  D  Q:DIOUT1!$G(DIERR)
        !            12:        . S DIFILE=$O(@DIFDA@(DIFILE))
        !            13:        . I 'DIFILE S DIOUT1=1 Q
        !            14:        . S DINODE=$G(^DD(DIFILE,.01,0))
        !            15:        . I DINODE="" D  Q
        !            16:        . . D ERR^DICA3($S('$D(^DD(DIFILE)):401,1:406),DIFILE)
        !            17:        . I $P(DINODE,U,2)["W" D  Q
        !            18:        . . D ERR^DICA3(407,DIFILE)
        !            19:        . S DIRID=$$RID^DICU(DIFILE)
        !            20: IENS   .
        !            21:        . S DIEN="",DIOUT2=0 F  D  Q:DIOUT2!$G(DIERR)
        !            22:        . . S DIEN=$O(@DIFDA@(DIFILE,DIEN))
        !            23:        . . I DIEN="" S DIOUT2=1 Q
        !            24:        . . N DIDA D IEN^DICA2(.DIFILE,DIEN,.DIDA,DIRULE,.DIOK) Q:$G(DIERR)
        !            25:        . . I 'DIOK S DIOUT1=1,DIOUT2=1 D  Q
        !            26:        . . . I $E(DIEN,$L(DIEN))'="," D ERR^DICA3(304,"",DIEN) Q
        !            27:        . . . D ERR^DICA3(202,"","","","IENS")
        !            28:        . . S DIOK=$$RID(DIFILE,DIEN,DIFDA,DIRID)
        !            29:        . . I 'DIOK D  Q
        !            30:        . . . I $P(DIEN,U)["+" D ERR^DICA3(311,"",DIEN) Q
        !            31:        . . . I $E(DIEN)="?",$P(DIOK,U,2)=".01" D ERR^DICA3(351,DIFILE,DIEN) Q
        !            32:        . . . D ERR712(DIFILE,$P(DIOK,U,2)) Q
        !            33:        . . I $D(@DIFDA@(DIFILE,DIEN,.001))#2 D
        !            34:        . . . N DIENS S DIENS=@DIFDA@(DIFILE,DIEN,.001)
        !            35:        . . . I $D(@DINUMS@(@DIRULE@("NUM")))[0 D
        !            36:        . . . . S @DINUMS@(@DIRULE@("NUM"))=DIENS
        !            37:        . . . S ^TMP("DIADD",$J,DIFILE,DIEN,.001)=DIENS
        !            38:        . . . K @DIFDA@(DIFILE,DIEN,.001)
        !            39: VALUES . .
        !            40:        . . I DIFLAGS'["E" Q
        !            41:        . . S DIFLD="",DIOUT3=0 F  D  Q:DIOUT3!$G(DIERR)
        !            42:        . . . S DIFLD=$O(@DIFDA@(DIFILE,DIEN,DIFLD))
        !            43:        . . . I DIFLD="" S DIOUT3=1 Q
        !            44:        . . . I DIFLD=.01,$E(DIEN)="?",$E(DIEN,2)'="+" Q
        !            45:        . . . S DIVAL=$G(@DIFDA@(DIFILE,DIEN,DIFLD))
        !            46:        . . . D DTYP^DIOU(DIFILE,DIFLD,.DITYPE)
        !            47:        . . . I DITYPE=5 S DINT=DIVAL
        !            48: CONVERT        . . .
        !            49:        . . . I DITYPE'=5 D  Q:$G(DIERR)
        !            50:        . . . . I DIEN["?"!(DIEN["+") D  Q:$G(DIERR)
        !            51:        . . . . . I "@"[DIVAL D  Q
        !            52:        . . . . . . I $P($G(^DD(DIFILE,DIFLD,0)),U,2)["R" D  Q
        !            53:        . . . . . . . D ERR712(DIFILE,DIFLD)
        !            54:        . . . . . . S DINT=DIVAL
        !            55:        . . . . . N DA M DA=DIDA
        !            56:        . . . . . N DIARG S DIARG="D0"
        !            57:        . . . . . N DIMAX S DIMAX=$O(DA(""),-1)
        !            58:        . . . . . N DIVAR F DIVAR=1:1:DIMAX S DIARG=DIARG_",D"_DIVAR
        !            59:        . . . . . N @DIARG F DIVAR=0:1:DIMAX-1 S @("D"_DIVAR)=DA(DIMAX-DIVAR)
        !            60:        . . . . . S @("D"_DIMAX)=DA
        !            61:        . . . . . D CHK^DIE(DIFILE,DIFLD,"",DIVAL,.DINT)
        !            62:        . . . . E  D  Q:$G(DIERR)
        !            63:        . . . . . D VAL^DIE(DIFILE,DIEN,DIFLD,"R",DIVAL,.DINT)
        !            64:        . . . . Q:$D(DINUM)[0
        !            65:        . . . . S @DINUMS@(@DIRULE@("NUM"))=DINUM K DINUM
        !            66:        . . . S @DIRULE@("FDA",DIFILE,DIEN,DIFLD)=DINT
        !            67: CLEANUP        
        !            68:        I $G(DIERR)!'DIOK K @DIRULE Q
        !            69:        K @DIRULE@("L"),@DIRULE@("NUM"),@DIRULE@("OP"),@DIRULE@("ROOT")
        !            70:        K @DIRULE@("SEQ"),@DIRULE@("TEMP"),@DIRULE@("UP")
        !            71:        S DIN=$NA(@DIRULE@("ORDER")),DIC=0
        !            72:        F  S DIN=$Q(@DIN) Q:DIN=""!($P(DIN,",",3)'="""ORDER""")  D
        !            73:        . S DIC=DIC+1,@DIRULE@("NEXT",DIC)=@DIN
        !            74:        K @DIRULE@("ORDER")
        !            75:        I DIFLAGS["E" S DIFDA=$NA(@DIRULE@("FDA"))
        !            76:        Q
        !            77:        
        !            78: RID(DIFILE,DIEN,DIFDA,DIOK)    
        !            79:        ; CHECK--return whether FDA entry sets all required identifiers
        !            80:        ; func, all passed by value
        !            81:        N DIP S DIP=$P(DIEN,",")
        !            82:        I $E(DIP)="?","@"[$G(@DIFDA@(DIFILE,DIEN,.01)) Q "0^.01"
        !            83:        N DIOK S DIOK=1
        !            84:        N DIC,DIR F DIC=1:1 S DIR=$P(DIRID,U,DIC) Q:DIR=""  D  I 'DIOK Q
        !            85:        . I DIP'["+",$D(@DIFDA@(DIFILE,DIEN,DIR))[0 Q
        !            86:        . S DIOK="@"'[$G(@DIFDA@(DIFILE,DIEN,DIR)) I 'DIOK S DIOK=DIOK_U_DIR
        !            87:        Q DIOK
        !            88:        
        !            89: ERR712(DIFILE,DIFIELD) 
        !            90:        N DIFILNAM S DIFILNAM=$$GET1^DID(DIFILE,"","","NAME")
        !            91:        N DIFLDNAM S DIFLDNAM=$$GET1^DID(DIFILE,DIFIELD,"","LABEL")
        !            92:        D ERR^DICA3(712,DIFILE,"",DIFIELD,DIFLDNAM,DIFILNAM)
        !            93:        Q