Return to DICA2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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