source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICA2.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1DICA2 ;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 ;
5IEN(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")
13PIECES ;
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
23ALLGOOD ;
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 ;
29PIECE(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
35FILING 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
49PREFIX S DIPREFIX=$E(DIPIECE,1,2) I DIPREFIX'="?+" S DIPREFIX=$E(DIPREFIX)
50 I DIPREFIX'="+",DIPREFIX'="?",DIPREFIX'="?+" S DIOK=0 Q
51 ;
52GOODPC 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
55FIRSTPC . I DICRSR=1 D
56 . . S @DIRULE@("OP")=$S(DIPREFIX="?":1,DIPREFIX="?+":2,1:3)
57 . . S @DIRULE@("NUM")=DISEQ
58WHEREPC . 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"))
61ILLEGAL . 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
66LEARN . S @DIRULE@("TEMP",DISEQ,DIPREFIX,DIF)=DIRIGHT
67 . I DICRSR=1 S DIDA=DIPREFIX
68 . E S DIDA(DICRSR-1)=DIPREFIX
69 ;
70BADPIEC S DIOK=0 Q
Note: See TracBrowser for help on using the repository browser.