Return to DICA2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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