source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICUIX2.m@ 1696

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1DICUIX2 ;SEA/TOAD,SF/TKW-FileMan: Build index data in DINDEX array (cont). ;11:19 AM 7 Nov 2000
2 ;;22.0;VA FileMan;**4,28,67**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5COMMON1 ; Put info about data subscripts into DINDEX array
6 N DIFR,DIPRT
7 S DIFR=$G(DIFROM(DISUB)),DIPRT=$G(DIPART(DISUB))
8 I DINDEX(DISUB,"FILE")=DIFILE S DINDEX("FLIST")=DINDEX("FLIST")_"^"_DINDEX(DISUB,"FIELD")
9 I DIFLAGS["q" D C3 Q
10 S DINDEX(DISUB,"USE")=0 D
11 . I DIFROM("IEN") S DINDEX(DISUB,"USE")=1 Q
12 . S:$G(DIFROM(DISUB+1))]"" DINDEX(DISUB,"USE")=1 Q
13C1 S DINDEX(DISUB,"WAY")=$S(DIFLAGS[4:1,DIWAY=DINDEX("WAY"):1,1:-1)
14 I $G(DINDEX("WAY","REVERSE")) S DITO(DISUB)=DIFR,DIFR=""
15C2 I DIFLAGS[4 S DINDEX(DISUB,"LENGTH")=DILENGTH
16 I DIFLAGS[3 D
17 . S DIFR=$E(DIFR,1,DILENGTH)
18 . S DIPRT=$E(DIPRT,1,DILENGTH)
19 . I $D(DITO(DISUB)) S DITO(DISUB)=$E(DITO(DISUB),1,DILENGTH)
20 . Q
21C3 I 'DINDEX(DISUB,"FILE")!('DINDEX(DISUB,"FIELD")) S DINODE="",DICODE="DINDEX(DISUB)"
22 E D GET^DICUIX1(DIFILE,DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),.DINODE,.DICODE)
23 I $G(DIERR) D
24 . S DINODE="",DICODE="DINDEX(DISUB)"
25 . D BLD^DIALOG(8099,DINDEX) Q
26 S DINDEX(DISUB,"GET")="DIVAL="_DICODE
27C4 S DITYPE=$P(DINODE,U,2)
28 N % S %="F" D S DINDEX(DISUB,"TYPE")=%
29 . Q:DIFLAGS["Q"
30 . I DITYPE["P" S %="P" Q
31 . I DITYPE["D" S %="D" Q
32 . I DITYPE["S" S %="S" Q
33 . I DITYPE["V" S %="V" Q
34 . I DITYPE["N" S %="N"
35 . Q
36 Q:DIFLAGS["q"
37 I DISUB=1 D
38 . S DITEMP=$S($D(DIFILE(DIFILE,"NO B")):DIFILE(DIFILE,"NO B"),1:DIFILE(DIFILE,"O")_"DINDEX")
39 . I "VP"[DINDEX(DISUB,"TYPE") D
40 . . S DINDEX(1,"NODE")=DINODE Q:DIFLAGS[4
41 . . I DIFLAGS'["Q",$$CHKP^DICUIX1(.DIFILE,.DINDEX,+$G(DINUMBER),DIFR_DIPRT,.DISCREEN) D Q
42 . . . D TMPIDX^DICUIX1(1,.DITEMP,.DITEMP2,.DINDEX) Q
43 . . S DINDEX("AT")=2 Q
44 . Q
45 I DISUB>1 D
46 . I DIFLAGS[4,"VP"[DINDEX(DISUB,"TYPE") S DINDEX(DISUB,"GET")="DIVAL=$G(DINDEX(DISUB,""EXT""))"
47 . I DIFLAGS[3,"VP"[DINDEX(DISUB,"TYPE"),DIFLAGS'["Q",'$D(DINDEX("ROOTCNG")) D TMPIDX^DICUIX1(DISUB,.DITEMP,.DITEMP2,.DINDEX) Q
48 . S DITEMP=DITEMP_"DINDEX("_(DISUB-1)_")"
49 . Q
50 S DINDEX(DISUB,"ROOT")=DITEMP_")",DITEMP=DITEMP_","
51 I $D(DITEMP2) D
52 . S:DISUB>1 DITEMP2=DITEMP2_"DIX("_(DISUB-1)_")"
53 . S DINDEX(DISUB,"IXROOT")=DITEMP2_")",DITEMP2=DITEMP2_","
54 . Q
55C5 S DINDEX(DISUB,"MORE?")=0
56 I +$P(DIPRT,"E")=DIPRT,DITYPE'["D" D
57 . I DINDEX(DISUB,"WAY")=-1 S DINDEX(DISUB,"MORE?")=1 Q
58 . I +$P(DIFR,"E")=DIFR!(DIFR="") S DINDEX(DISUB,"MORE?")=1
59 . Q
60C6 I DIPRT]"" D
61 . I DIFLAGS[4,"VP"[DINDEX(DISUB,"TYPE") Q:DIFLAGS'["l" Q:DISUB>1
62 . I DITYPE["D",DIFLAGS[3 D Q
63 . . N I S I=$S(DINDEX(DISUB,"WAY")=1:"0000000",1:9999999)
64 . . D DAT(.DIFR,DIPRT,I,DINDEX(DISUB,"WAY"),.DIOUT) Q
65 . Q:$E(DIFR,1,$L(DIPRT))=DIPRT
66 . I DINDEX(DISUB,"WAY")=1 D Q
67 . . I DIFR]](DIPRT_$S(+$P(DIPRT,"E")=DIPRT:" ",1:"")) S DIOUT=1 Q
68 . . I +$P(DIPRT,"E")=DIPRT,DIPRT<0 S DIFR=$S(DIPRT[".":$P(DIPRT,".")-1,1:"") Q
69 . . I +$P(DIPRT,"E")=DIPRT,+$P(DIFR,"E")=DIFR,DIFR>DIPRT Q
70 . . S DINDEX(DISUB,"USE")=1
71 . . S DIFR=DIPRT_$S(+$P(DIPRT,"E")'=DIPRT:"",DIFR]]DIPRT:" ",1:"")
72 . . Q
73 . I DIFR'="",DIPRT]]DIFR S DIOUT=1 Q
74 . I +$P(DIPRT,"E")=DIPRT,DIFR?.1"-"1.N.E Q
75 . S DINDEX(DISUB,"USE")=1
76 . S DIFR=DIPRT_"{{{{{{{{{{"
77 . Q
78 S DINDEX(DISUB)=$G(DIFR) I DIFR]"" S DINDEX(DISUB,"FROM")=DIFR
79 I DIPRT]"" S DINDEX(DISUB,"PART")=DIPRT
80 I $D(DITO(DISUB)) S DINDEX(DISUB,"TO")=DITO(DISUB)
81C7 I $G(DIDENT(-5)) D
82 . I $D(DINDEX(DISUB,"TRANOUT")) S DINDEX(DISUB,"GETEXT")=DIGET Q
83 . N T S T=DITYPE I T'["D",T'["S",T'["P",T'["V",T'["O" Q
84 . I DIFLAGS[3,"PV"[DINDEX(DISUB,"TYPE"),(DISUB>1!($D(DINDEX("ROOTCNG",1)))) D
85 . . I DINDEX(DISUB,"FILE")'=DIFILE S DIGET=0 Q
86 . . S DIGET=2 Q
87 . S DINDEX(DISUB,"GETEXT")=DIGET Q
88 Q
89 ;
90COMMON2 ; Put data about IEN subscript into DINDEX array.
91 N DIEN S DIEN=DINDEX("#")+1
92 S:DINDEX'="#" DINDEX(DIEN,"ROOT")=DITEMP_"DINDEX("_(DIEN-1)_"))"
93 I $D(DITEMP2) S DINDEX(DIEN,"IXROOT")=DITEMP2_"DIX("_(DIEN-1)_"))"
94 I $G(DINDEX("WAY","REVERSE")),DIFROM("IEN") S DINDEX(DIEN,"TO")=DIFROM("IEN"),DIFROM("IEN")=""
95 S DINDEX(DIEN)=DIFROM("IEN")
96 I DINDEX(DIEN)=0,DINDEX("WAY")=-1 S DINDEX(DIEN)=""
97 I DIFROM("IEN") S DINDEX(DIEN,"FROM")=DIFROM("IEN")
98 S DINDEX(DIEN,"WAY")=DINDEX("WAY")
99 Q
100 ;
101DAT(DIFR,DIPRT,DIAPP,DIWAY,DIOUT) ; Process FROM and PART for dates
102 N L,P,DIPART S L=$L(DIFR),P=$L(DIPRT),DIPART=DIPRT
103 I L<P S DIFR=DIFR_$E(DIPART,L+1,P)
104 I $L(DIFR)<7 S DIFR=$E(DIFR_DIAPP,1,7)
105 Q:$E(DIFR,1,P)=DIPART
106 I P<7 S DIPART=$E(DIPART_DIAPP,1,7)
107 I DIWAY=1,DIFR]]DIPART S DIOUT=1 Q
108 I DIWAY=-1,DIPART]]DIFR S DIOUT=1 Q
109 S $E(DIFR,1,P)=DIPRT
110 S DINDEX(DISUB,"USE")=1
111 Q
112 ;
Note: See TracBrowser for help on using the repository browser.