freem_fileman/USER/DICA2.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DICA2.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (5 weeks, 4 days ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

DICA2 ;SEA/TOAD-VA FileMan: Updater, Pre-Processor Part 2 ;11/15/94 16:20 ; ;;21.0;VA FileMan;;Dec 28, 1994 ;Per VHA Directive 10-93-142, this routine should not be modified. IEN(DIFILE,DIEN,DIDA,DIRULE,DIOK) ; ENTRY POINT--return whether the IEN String is valid ; proc, DIEN passed by value I $G(DIFILE("C"))'=DIFILE D PARENTS^DIDU1(.DIFILE,DIRULE) I $E(DIEN,$L(DIEN))'="," D ERR^DICA3(304,"",DIEN) Q I DIFILE("L")+1'=$L(DIEN,",") D ERR^DICA3(205,"",DIEN,"",DIFILE) Q I $E(DIEN)=","!(DIEN[",,") D ERR^DICA3(307,"",DIEN) Q K @DIRULE@("TEMP") PIECES K DIDA N DICRSR,DIOUT S DIOUT=0 F DICRSR=1:1 D Q:DIOUT!$G(DIERR) . N DIPIECE S DIPIECE=$P(DIEN,",",DICRSR) . N DIRIGHT S DIRIGHT=$P(DIEN,",",DICRSR+1,99999) . I DIPIECE="" S DIOUT=1,DIOK=1 Q . D PIECE(.DIFILE,DIFDA,DIRULE,DICRSR,DIPIECE,.DIDA,DIRIGHT,.DIOK) . I $G(DIERR) S DIOK=0 Q . I 'DIOK D ERR^DICA3($S(DIOK=0:308,1:310),"",DIEN) Q . Q I $G(DIERR) Q ALLGOOD M @DIRULE@("SEQ")=@DIRULE@("TEMP") N DIN S DIN="S DIFILE="_DIFILE_",DIENTRY="""_DIEN_"""" S @DIRULE@("ORDER",@DIRULE@("OP"),DIFILE("L"),DIFILE,@DIRULE@("NUM"))=DIN Q PIECE(DIFILE,DIFDA,DIRULE,DICRSR,DIPIECE,DIDA,DIRIGHT,DIOK) ; IEN--return whether a piece of the IEN String is valid ; proc, DIF, DIOK, & DIRULE passed by ref N DICHECK,DIF,DIPREFIX,DIR,DISEQ S DIF=DIFILE(DICRSR) I DIPIECE'["+",DIRIGHT["+" S DIOK=0 Q FILING I +DIPIECE=DIPIECE,$E(DIPIECE)'="+" D Q . S DIOK=DIPIECE>0 I 'DIOK Q . S DIOK=DIRIGHT'["+"&(DIRIGHT'["?") I 'DIOK Q . S DIR=$G(@DIRULE@("ROOT",DIF,","_DIRIGHT)) . I DIR="" D . . S DIR=$$ROOT^DIQGU(DIF,","_DIRIGHT,1,1) . . S @DIRULE@("ROOT",DIF,","_DIRIGHT)=DIR . S DIOK=$P($G(@DIR@(DIPIECE,0)),U)'="" . I 'DIOK D ERR^DICA3(601,DIFILE,DIPIECE_","_DIRIGHT) Q . I DICRSR=1 S DIDA=DIPIECE . E S DIDA(DICRSR-1)=DIPIECE . I DICRSR'=1 Q . S @DIRULE@("OP")=4 . S @DIRULE@("NUM")=DIPIECE PREFIX S DIPREFIX=$E(DIPIECE,1,2) I DIPREFIX'="?+" S DIPREFIX=$E(DIPREFIX) I DIPREFIX'="+",DIPREFIX'="?",DIPREFIX'="?+" S DIOK=0 Q GOODPC I $P(DIPIECE,DIPREFIX,2,9999)?1N.N S DIOK=1 D Q . S DISEQ=$P(DIPIECE,DIPREFIX,2,999) . I +DISEQ'=DISEQ S DIOK=0 Q FIRSTPC . I DICRSR=1 D . . S @DIRULE@("OP")=$S(DIPREFIX="?":1,DIPREFIX="+":2,1:3) . . S @DIRULE@("NUM")=DISEQ WHEREPC . S DICHECK="" . I $D(@DIRULE@("SEQ",DISEQ)) S DICHECK=$NA(@DIRULE@("SEQ")) . E I $D(@DIRULE@("TEMP",DISEQ)) S DICHECK=$NA(@DIRULE@("TEMP")) ILLEGAL . I DICHECK'="" D I 'DIOK Q . . I $O(@DICHECK@(DISEQ,""))'=DIPREFIX S DIOK="C" Q . . I $O(@DICHECK@(DISEQ,DIPREFIX,""))'=DIF S DIOK="C" Q . . I $G(@DICHECK@(DISEQ,DIPREFIX,DIF))'=DIRIGHT S DIOK="C" Q . I DICHECK="",'$D(@DIFDA@(DIF,DIPIECE_","_DIRIGHT)) S DIOK="C" Q LEARN . S @DIRULE@("TEMP",DISEQ,DIPREFIX,DIF)=DIRIGHT . I DICRSR=1 S DIDA=DIPREFIX . E S DIDA(DICRSR-1)=DIPREFIX BADPIEC S DIOK=0 Q