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

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

initial load of WorldVistAEHR

File size: 5.8 KB
RevLine 
[613]1DICF ;SEA/TOAD,SF/TKW-VA FileMan: Finder, Part 1 (Main) ;3/13/00 10:10
2 ;;22.0;VA FileMan;**20,31**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4FIND(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DIVALUE,DINUMBER,DIFORCE,DISCREEN,DIWRITE,DILIST,DIMSGA,DINDEX,DIC,DIY,DIYX) ;
5 ; ENTRY POINT--silent selecter
6 ;
7FINDX ; branch in from FIND^DIC
8 I '$D(DIQUIET),$G(DIC(0))'["E" N DIQUIET S DIQUIET=1
9 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
10 N DICLERR S DICLERR=$G(DIERR) K DIERR
11 N DIEN,DIFAIL
12 M DIEN=DIVALUE N DIVALUE M DIVALUE=DIEN K DIEN
13 N DIDENT S DIDENT(-1)=+$G(DILIST("C"))
14 ;
15INPUT ; Verify correctness of input parameters
16 S DIFLAGS=$G(DIFLAGS)
17 I DIFLAGS'["l" N DINDEX S DINDEX("WAY")=1
18 S DIFAIL=0 D I DIFAIL D CLOSE Q
19I0 . ; flags
20 . I DIFLAGS["p" S DIFLAGS=DIFLAGS_"f"
21 . I DIFLAGS'["p" D Q:DIFAIL
22 . . I $G(DIFIELDS)["IX",DIFIELDS'["-IX" D
23 . . . N D S D=";"_DIFIELDS_";" I D'[";IX;",D'[";IXE",D'[";IXIE" Q
24 . . . S DIDENT(-5)=1 Q
25 . . S DIFLAGS=DIFLAGS_4
26 . . I DIFLAGS["O",DIFLAGS["X" S DIFLAGS=$TR(DIFLAGS,"O")
27 . . S DIFLAGS=DIFLAGS_"t"
28I1 . . ; value
29 . . I DIFLAGS'["l" N DIERRM D I DIFAIL D ERR^DICF4(202,"","","",DIERRM) Q
30 . . . S DIERRM="Lookup values"
31 . . . I $G(DIVALUE(1))="" S DIVALUE(1)=$G(DIVALUE)
32 . . . N I,DIEND S DIFAIL=1,DIEND=$O(DIVALUE(999999),-1)
33 . . . F I=1:1:DIEND S DIVALUE(I)=$G(DIVALUE(I)) I DIVALUE(I)]"" S DIFAIL=$$BADVAL(DIVALUE(I)) Q:DIFAIL
34 . . . Q
35 . . Q
36I2 . ; target_root
37 . S DILIST=$G(DILIST)
38 . I DILIST'="",DIFLAGS'["l" D
39 . . I DIFLAGS'["p" K @DILIST
40 . . I DIFLAGS'["f" S DILIST=$NA(@DILIST@("DILIST"))
41 . . Q
42 . I DILIST="" S DILIST="^TMP(""DILIST"",$J)" K @DILIST
43I3 . ; file and screens
44 . D:DIFLAGS'["v"&(DIFLAGS'["l") FILE^DICUF(.DIFILE,.DIFIEN,DIFLAGS)
45 . I $G(DIERR) S DIFAIL=1 Q
46 . D SCREEN^DICUF(DIFLAGS,.DIFILE,.DISCREEN)
47 . D DA^DILF(DIFIEN,.DIEN)
48I4 . ; fields
49 . S DIFIELDS=$G(DIFIELDS)
50I5 . ; flags again
51 . I DIFLAGS'["p",DIFLAGS'["l" D Q:DIFAIL
52 . . I $TR(DIFLAGS,"ABCKMOPQSUXfglpqtv4")'="" S DIFAIL=1 D Q
53 . . . D ERR^DICF4(301,"","","",$TR(DIFLAGS,"fglpqtv4")) Q
54 . . Q
55I6 . ; determine starting index.
56 . I DIFLAGS'["l" D Q:DIFAIL
57 . . S DIFORCE=$G(DIFORCE),DIFORCE(1)=1
58 . . I "*"[DIFORCE D
59 . . . I DIFLAGS["M" S DIFORCE=0,DIFORCE(0)="*" Q
60 . . . S DIFORCE(0)=$$DINDEX^DICL(DIFILE,DIFLAGS),DIFORCE=1 Q
61 . . E D I DIFAIL D ERR^DICF4(202,"","","","Indexes") Q
62 . . . I $P(DIFORCE,U)="" S DIFAIL=1 Q
63 . . . S DIFORCE(0)=DIFORCE,DIFORCE=1
64 . . . I $P(DIFORCE(0),U,2)]"",DIFLAGS'["M" S DIFLAGS=DIFLAGS_"M"
65 . . . Q
66 . . I DIFORCE S DINDEX=$P(DIFORCE(0),U) Q
67 . . S DINDEX=$$DINDEX^DICL(DIFILE,DIFLAGS) Q
68I7 . ; rest
69 . I DIFLAGS'["p",DIFLAGS'["l" D Q:DIFAIL
70 . . S DINUMBER=$S($G(DINUMBER):DINUMBER,1:"*")
71 . . I DINUMBER'="*" D Q:DIFAIL
72 . . . I DINUMBER\1=DINUMBER,DINUMBER>0 Q
73 . . . S DIFAIL=1 D ERR^DICF4(202,"","","","Number")
74 . . . Q
75 . . Q
76 . S DIWRITE=$G(DIWRITE)
77 . Q
78I8 I DIFLAGS["P" S DIDENT(-3)=""
79 S DIDENT(-1,"JUST LOOKING")=0,DIDENT(-1,"MAX")=DINUMBER,DIDENT(-1,"MORE?")=0
80 N DIOUT S DIOUT=0
81 ;
82HOOK75 ;
83 N DIHOOK75
84 S DIHOOK75=$G(^DD(DIFILE,.01,7.5))
85 I DIHOOK75'="",DIVALUE(1)]"",DIVALUE(1)'?."?",'$O(DIVALUE(1)),DIFLAGS'["l" D I DIOUT D CLOSE Q
86 . I DIFLAGS["p" N DIC D
87 . . S DIC=DIFILE,DIC(0)=$TR(DIFLAGS,"2^fglpqtv4") Q
88 . N %,D,X,Y,Y1
89 . S X=DIVALUE(1),D=DINDEX
90 . M Y=DIEN S Y="",Y1=DIFIEN
91 . X DIHOOK75 I '$D(X)!$G(DIERR) S DIOUT=1 D:$G(DIERR) Q
92 . . S %=$$EZBLD^DIALOG(8090)
93 . . D ERR^DICF4(120,DIFILE,"",.01,%)
94 . S DIVALUE(1)=X,DIOUT=$$BADVAL(DIVALUE(1)) Q:DIOUT
95 . I $G(DIC("S"))'="" S DISCREEN("S")=DIC("S")
96 . I $G(DIC("V"))'="" S (DISCREEN("V"),DISCREEN("V",1))=DIC("V")
97 ;
98LOOKUP ;
99 I DIFLAGS'["l" D I DIOUT!($G(DIERR)) D CLOSE Q
100 . D INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,"",.DIVALUE,DINUMBER,.DISCREEN,DILIST,.DIOUT) Q
101 I '$D(DINDEX("MAXSUB")) D
102 . S DINDEX("MAXSUB")=$P($G(^DD("OS",+$G(^DD("OS")),0)),U,7)
103 . I DINDEX("MAXSUB") S DINDEX("MAXSUB")=DINDEX("MAXSUB")-13 Q
104 . S DINDEX("MAXSUB")=50 Q
105 I $D(DISCREEN("V")) D VPDATA^DICUF(.DINDEX,.DISCREEN)
106 I (DINDEX'="#")!($O(DIVALUE(1))) D CHKVAL1^DIC0(DINDEX("#"),.DIVALUE,DIFLAGS) I $G(DIERR) D CLOSE Q
107 I DIFLAGS'["f" D I $G(DIERR) D CLOSE Q
108 . D IDENTS^DICU1(DIFLAGS,.DIFILE,DIFIELDS,DIWRITE,.DIDENT,.DINDEX)
109 . Q
110 I DIFLAGS'["p",DIFLAGS'["l" D I DIOUT!($G(DIERR)) D CLOSE Q
111 . N I F I=2:1:DINDEX("#") Q:$G(DIVALUE(I))]""
112 . Q:$G(DIVALUE(I))]""
113 . D SPECIAL^DICF1(.DIFILE,.DIEN,DIFIEN,DIFLAGS,DIVALUE(1),.DINDEX,.DISCREEN,.DIDENT,.DIOUT,.DILIST)
114 . Q
115 I DIFLAGS["t" D XFORM^DICF1(.DIFLAGS,.DIVALUE,.DISCREEN,.DINDEX)
116 I DINDEX("#")>1,DIVALUE(1)="" N S M S=DISCREEN N DISCREEN M DISCREEN=S K S D
117 . I DIFIELDS["IX",DIFIELDS'["-IX" Q
118 . N DISAVMAX S DISAVMAX=DINDEX("MAXSUB")
119 . D ALTIDX^DICF0(.DINDEX,.DIFILE,.DIVALUE,.DISCREEN,DINUMBER)
120 . S DINDEX("MAXSUB")=DISAVMAX Q
121 D CHKALL^DICF2(.DIFILE,.DIEN,DIFIEN,.DIFLAGS,.DIVALUE,.DISCREEN,DINUMBER,.DIFORCE,.DINDEX,.DIDENT,.DILIST,.DIC,.DIY,.DIYX)
122 D CLOSE
123 Q
124 ;
125BADVAL(DIVALUE) ; Check for invalid characters in value
126 I "^"[DIVALUE Q 1
127 I DIVALUE'?.ANP D ERR^DICF4(204,"","","",DIVALUE) Q 1
128 Q 0
129CLOSE ;
130 ; cleanup
131 I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
132 I DICLERR'=""!$G(DIERR) D
133 . I DIFLAGS["l",+DIERR=1 Q
134 . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
135 I $G(DIERR) D Q
136 . Q:$G(DILIST)="" K @DILIST@("B") Q
137 I DIFLAGS["p" S @DILIST=DIDENT(-1) Q
138 Q:DIFLAGS["l"
139 S @DILIST@(0)=DIDENT(-1)_U_DIDENT(-1,"MAX")_U_DIDENT(-1,"MORE?")_U_$S(DIFLAGS[2:"H",1:"")
140 I DIFLAGS["P" S @DILIST@(0,"MAP")=$G(DIDENT(-3))
141 E D SETMAP^DICL1(.DIDENT,DILIST)
142 K @DILIST@("B")
143 Q
144 ;
145 ; Error messages:
146 ; 120 The previous error occurred when performin
147 ; 202 The input parameter that identifies the |1
148 ; 204 The input value contains control character
149 ; 301 The passed flag(s) '|1|' are unknown or in
150 ; 8090 Pre-lookup transform (7.5 node)
151 ; 8093 Too many lookup values for this index.
152 ; 8094 Not enough lookup values provided for an e
153 ; 8095 Only one compound index allowed on a looku
154 ;
Note: See TracBrowser for help on using the repository browser.