| [613] | 1 | DICA2 ;SEA/TOAD-VA FileMan: Updater, Pre-Processor Part 2 ;8:12 AM 10 Jun 1998
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
