Return to DICA2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICA2.m, revision 1.1

1.1     ! snw         1: DICA2  ;SEA/TOAD-VA FileMan: Updater, Pre-Processor Part 2 ;11/15/94  16:20 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        
        !             5: IEN(DIFILE,DIEN,DIDA,DIRULE,DIOK)      
        !             6:        ; ENTRY POINT--return whether the IEN String is valid
        !             7:        ; proc, DIEN passed by value
        !             8:        I $G(DIFILE("C"))'=DIFILE D PARENTS^DIDU1(.DIFILE,DIRULE)
        !             9:        I $E(DIEN,$L(DIEN))'="," D ERR^DICA3(304,"",DIEN) Q
        !            10:        I DIFILE("L")+1'=$L(DIEN,",") D ERR^DICA3(205,"",DIEN,"",DIFILE) Q
        !            11:        I $E(DIEN)=","!(DIEN[",,") D ERR^DICA3(307,"",DIEN) Q
        !            12:        K @DIRULE@("TEMP")
        !            13: PIECES 
        !            14:        K DIDA N DICRSR,DIOUT S DIOUT=0 F DICRSR=1:1 D  Q:DIOUT!$G(DIERR)
        !            15:        . N DIPIECE S DIPIECE=$P(DIEN,",",DICRSR)
        !            16:        . N DIRIGHT S DIRIGHT=$P(DIEN,",",DICRSR+1,99999)
        !            17:        . I DIPIECE="" S DIOUT=1,DIOK=1 Q
        !            18:        . D PIECE(.DIFILE,DIFDA,DIRULE,DICRSR,DIPIECE,.DIDA,DIRIGHT,.DIOK)
        !            19:        . I $G(DIERR) S DIOK=0 Q
        !            20:        . I 'DIOK D ERR^DICA3($S(DIOK=0:308,1:310),"",DIEN) Q
        !            21:        . Q
        !            22:        I $G(DIERR) Q
        !            23: ALLGOOD        
        !            24:        M @DIRULE@("SEQ")=@DIRULE@("TEMP")
        !            25:        N DIN S DIN="S DIFILE="_DIFILE_",DIENTRY="""_DIEN_""""
        !            26:        S @DIRULE@("ORDER",@DIRULE@("OP"),DIFILE("L"),DIFILE,@DIRULE@("NUM"))=DIN
        !            27:        Q
        !            28:        
        !            29: PIECE(DIFILE,DIFDA,DIRULE,DICRSR,DIPIECE,DIDA,DIRIGHT,DIOK)    
        !            30:        ; IEN--return whether a piece of the IEN String is valid
        !            31:        ; proc, DIF, DIOK, & DIRULE passed by ref
        !            32:        N DICHECK,DIF,DIPREFIX,DIR,DISEQ
        !            33:        S DIF=DIFILE(DICRSR)
        !            34:        I DIPIECE'["+",DIRIGHT["+" S DIOK=0 Q
        !            35: FILING I +DIPIECE=DIPIECE,$E(DIPIECE)'="+" D  Q
        !            36:        . S DIOK=DIPIECE>0 I 'DIOK Q
        !            37:        . S DIOK=DIRIGHT'["+"&(DIRIGHT'["?") I 'DIOK Q
        !            38:        . S DIR=$G(@DIRULE@("ROOT",DIF,","_DIRIGHT))
        !            39:        . I DIR="" D
        !            40:        . . S DIR=$$ROOT^DIQGU(DIF,","_DIRIGHT,1,1)
        !            41:        . . S @DIRULE@("ROOT",DIF,","_DIRIGHT)=DIR
        !            42:        . S DIOK=$P($G(@DIR@(DIPIECE,0)),U)'=""
        !            43:        . I 'DIOK D ERR^DICA3(601,DIFILE,DIPIECE_","_DIRIGHT) Q
        !            44:        . I DICRSR=1 S DIDA=DIPIECE
        !            45:        . E  S DIDA(DICRSR-1)=DIPIECE
        !            46:        . I DICRSR'=1 Q
        !            47:        . S @DIRULE@("OP")=4
        !            48:        . S @DIRULE@("NUM")=DIPIECE
        !            49: PREFIX S DIPREFIX=$E(DIPIECE,1,2) I DIPREFIX'="?+" S DIPREFIX=$E(DIPREFIX)
        !            50:        I DIPREFIX'="+",DIPREFIX'="?",DIPREFIX'="?+" S DIOK=0 Q
        !            51:        
        !            52: GOODPC I $P(DIPIECE,DIPREFIX,2,9999)?1N.N S DIOK=1 D  Q
        !            53:        . S DISEQ=$P(DIPIECE,DIPREFIX,2,999)
        !            54:        . I +DISEQ'=DISEQ S DIOK=0 Q
        !            55: FIRSTPC        . I DICRSR=1 D
        !            56:        . . S @DIRULE@("OP")=$S(DIPREFIX="?":1,DIPREFIX="+":2,1:3)
        !            57:        . . S @DIRULE@("NUM")=DISEQ
        !            58: WHEREPC        . S DICHECK=""
        !            59:        . I $D(@DIRULE@("SEQ",DISEQ)) S DICHECK=$NA(@DIRULE@("SEQ"))
        !            60:        . E  I $D(@DIRULE@("TEMP",DISEQ)) S DICHECK=$NA(@DIRULE@("TEMP"))
        !            61: ILLEGAL        . I DICHECK'="" D  I 'DIOK Q
        !            62:        . . I $O(@DICHECK@(DISEQ,""))'=DIPREFIX S DIOK="C" Q
        !            63:        . . I $O(@DICHECK@(DISEQ,DIPREFIX,""))'=DIF S DIOK="C" Q
        !            64:        . . I $G(@DICHECK@(DISEQ,DIPREFIX,DIF))'=DIRIGHT S DIOK="C" Q
        !            65:        . I DICHECK="",'$D(@DIFDA@(DIF,DIPIECE_","_DIRIGHT)) S DIOK="C" Q
        !            66: LEARN  . S @DIRULE@("TEMP",DISEQ,DIPREFIX,DIF)=DIRIGHT
        !            67:        . I DICRSR=1 S DIDA=DIPREFIX
        !            68:        . E  S DIDA(DICRSR-1)=DIPREFIX
        !            69:        
        !            70: BADPIEC        S DIOK=0 Q