71 lines
2.8 KiB
Mathematica
71 lines
2.8 KiB
Mathematica
DICA2 ;SEA/TOAD-VA FileMan: Updater, Pre-Processor Part 2 ;8:12 AM 10 Jun 1998
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;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
|