source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQPTQ5.m@ 1452

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1ORQPTQ5 ; SLC/PKS - Functions for Patient Selection Lists. [4/23/04 4:49pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**82,85,187,190**;Dec 17, 1997
3 ;
4 Q
5 ;
6COMBDISP(ORQDUZ,ORQPTR) ; Display user's "Combination" pt selection sources.
7 ;
8 ; Variables used:
9 ;
10 ; ORQCNT = Counter for number of entries displayed.
11 ; ORQDUZ = DUZ of user involved.
12 ; ORQPTR = IEN for user's OE/RR PT SEL COMBO file entries.
13 ; ORQSRC = $O command values from combo entries, file ^OR(100.24,.
14 ; ORQTXT = Text name string for combo entry pointers.
15 ;
16 N ORQCNT,ORQSRC,ORQTXT
17 ;
18 ; Check passed variables, punt on errors:
19 S ORQCNT=0
20 I '($D(ORQDUZ)) W !,"No user DUZ passed.",! Q ORQCNT
21 I '($D(ORQPTR)) W !,"No combination pointer passed.",! Q ORQCNT
22 I ORQDUZ="" W !,"No user DUZ passed.",! Q ORQCNT
23 I ORQPTR="" W !,"No combination pointer passed.",! Q ORQCNT
24 ;
25 ; Order through the user's combination source entries:
26 K ^TMP("OR",$J,"ORQCPL")
27 S ORQSRC=0
28 F S ORQSRC=$O(^OR(100.24,ORQPTR,.01,ORQSRC)) Q:'ORQSRC D
29 .;
30 .; Get the actual source name based on the pointer entry value:
31 .S ORQTXT=""
32 .S ORQTXT=$G(^OR(100.24,ORQPTR,.01,ORQSRC,0))
33 .I '(ORQTXT="") D
34 ..S ORQCNT=ORQCNT+1 ; Increment counter.
35 ..S ORQTXT=$$COMBNM(ORQTXT) ; Call tag to create complete string.
36 ..;
37 ..; Write to ^TMP file for sorting:
38 ..I ORQTXT'="" S ^TMP("OR",$J,"ORQCPL",$P(ORQTXT,U))=$P(ORQTXT,U,2)
39 ;
40 ; Write data to the screen:
41 I ORQCNT D ; Data to write?
42 .S ORQTXT="" ; Reset, re-use.
43 .F S ORQTXT=$O(^TMP("OR",$J,"ORQCPL",ORQTXT)) Q:ORQTXT="" D
44 ..W !,$G(^TMP("OR",$J,"ORQCPL",ORQTXT))
45 ;
46 K ^TMP("OR",$J,"ORQCPL") ; Clean house.
47 ;
48 Q ORQCNT ; Return counter.
49 ;
50COMBNM(ORQVAL) ; Returns name of "Combination" source entry, ^OR(100.24 file.
51 ;
52 ; Returned string is "X_Name^String" where X is letter of type,
53 ; Name is name of entity, and String resembles examples below:
54 ;
55 ; W_1W^Ward: 1W SURGERY WEST
56 ; P_JONES,WILMA MD^Provider: JONES,WILMA MD
57 ; T_SURGERYLIST2^Team List: SURGERYLIST2
58 ; (Etc.)
59 ;
60 ; Variables used:
61 ;
62 ; ORQFILE = File for retrieval of name.
63 ; ORQPTR = Name string to return.
64 ; ORQRTN = Value returned by this function.
65 ; ORQVAL = Combo source entry pointer.
66 ;
67 N ORQPTR,ORQFILE,ORQRTN
68 I '($D(ORQVAL)) Q ORQRTN ; Error - punt.
69 ;
70 S ORQRTN="No source found...." ; Default init.
71 S ORQPTR=$P(ORQVAL,";") ; Get pointer.
72 S ORQFILE="^"_$P(ORQVAL,";",2) ; Get file.
73 ;
74 I ORQFILE="^DIC(42," D Q ORQRTN ; Wards.
75 .S ORQRTN=$G(^DIC(42,ORQPTR,0))
76 .I $D(ORQRTN) S ORQRTN="W"_"_"_$P(ORQRTN,U)_U_"Ward: "_$P(ORQRTN,U)_" "_$P(ORQRTN,U,2)
77 ;
78 I ORQFILE="^VA(200," D Q ORQRTN ; Providers.
79 .S ORQRTN=$G(^VA(200,ORQPTR,0))
80 .I $D(ORQRTN) S ORQRTN="P"_"_"_$P(ORQRTN,U)_U_"Provider: "_$P(ORQRTN,U)
81 ;
82 I ORQFILE="^DIC(45.7," D Q ORQRTN ; Specialties.
83 .S ORQRTN=$G(^DIC(45.7,ORQPTR,0))
84 .I $D(ORQRTN) S ORQRTN="S"_"_"_$P(ORQRTN,U)_U_"Specialty: "_$P(ORQRTN,U)
85 ;
86 I ORQFILE="^OR(100.21," D Q ORQRTN ; Team Lists.
87 .S ORQRTN=$G(^OR(100.21,ORQPTR,0))
88 .I $D(ORQRTN) S ORQRTN="T"_"_"_$P(ORQRTN,U)_U_"Team List: "_$P(ORQRTN,U)
89 ;
90 I ORQFILE="^SC(" D Q ORQRTN ; Clinics.
91 .S ORQRTN=$G(^SC(ORQPTR,0))
92 .I $D(ORQRTN) S ORQRTN="C"_"_"_$P(ORQRTN,U)_U_"Clinic: "_$P(ORQRTN,U)
93 ;
94 ; Return value (null will be returned if nothing matched):
95 Q ORQRTN
96 ;
97PTSCOMBO(ORQTYP,ORQPTR) ; Write ^TMP("OR",$J,"PATIENTS","B") patient entries.
98 ;
99 ; Called from COMBPTS^ORQPTQ6.
100 ; (ORQCNT,ORQPDAT,ORQPIEN,ORQPNM,ORQPSTAT,SORT new'd in calling tag.)
101 ; (Array ORY new'd in calling routine ORQPTQ2.)
102 ;
103 ; Variables used:
104 ;
105 ; ORQDOB = Patient DOB.
106 ; ORQDONE = Flag for end of patient records.
107 ; ORQIDT = Clinic app't date stored in internal format.
108 ; ORQMORE = Room/bed or appointment information.
109 ; ORQPTR = PASSED: Pointer from subfile entry, combination file.
110 ; ORQSNM = Name of source from subfile entry pointer.
111 ; ORQSNM4 = First four letters of name of source.
112 ; ORQSSN = Patient SSN suffix.
113 ; ORQTYP = PASSED: Holds source type:
114 ;
115 ; W = Ward
116 ; P = Provider
117 ; S = Specialty
118 ; T = Team List
119 ; C = Clinic
120 ;
121 N ORQDOB,ORQDONE,ORQIDT,ORQMORE,ORQSNM,ORQSNM4,ORQSSN
122 ;
123 ; Initialize variables:
124 S ORQDONE=0
125 S ORQCNT=1
126 ;
127 ; Get name data for source:
128 S ORQSNM4="" ; Default setting.
129 I ORQTYP="W" S ORQSNM4=$G(^DIC(42,ORQPTR,0)) ; Wards.
130 I ORQTYP="P" S ORQSNM4=$G(^VA(200,ORQPTR,0)) ; Providers.
131 I ORQTYP="S" S ORQSNM4=$G(^DIC(45.7,ORQPTR,0)) ; Specialties.
132 I ORQTYP="T" S ORQSNM4=$G(^OR(100.21,ORQPTR,0)) ; Team Lists.
133 I ORQTYP="C" S ORQSNM4=$G(^SC(ORQPTR,0)) ; Clinics.
134 ;
135 ; Assure use of first 4 letters of name:
136 S ORQSNM4=$P(ORQSNM4,U)_" " ; Add 4 for safety.
137 S ORQSNM4=$E(ORQSNM4,1,4) ; Get first 4 only.
138 ;
139 ; Add label prefix to source name:
140 S ORQSNM="" ; Default setting.
141 S ORQSNM=$S(ORQTYP="W":"Wd ",ORQTYP="P":"Pr ",ORQTYP="S":"Sp ",ORQTYP="T":"Tm ",ORQTYP="C":"Cl ",1:" ") ; Get correct name.
142 S ORQSNM=ORQSNM_ORQSNM4 ; Prepend label.
143 ;
144 ; Order thru ORY array created by calls in calling routine:
145 S ORQPDAT="" ; Initialize.
146 F S ORQPDAT=$G(ORY(ORQCNT)) Q:((ORQPDAT="")!(ORQDONE)) D
147 .;
148 .; Clear variables each time:
149 .S (ORQPIEN,ORQPNM,ORQSSN,ORQDOB,ORQIDT,ORQMORE,ORQPSTAT)=""
150 .;
151 .S ORQPIEN=$P(ORQPDAT,U) ; Get patient IEN.
152 .I ORQPIEN="" S ORQDONE=1 Q ; Punt if no IEN.
153 .S ORQPNM=$P(ORQPDAT,U,2) ; Get patient name.
154 .;
155 .; Get patient SSN suffix:
156 .S ORQSSN=$$ID($G(ORQPIEN))
157 .;
158 .; Get patient DOB:
159 .S ORQDOB=$$FMTE^XLFDT($P($G(^DPT(ORQPIEN,0)),U,3))
160 .;
161 .; Get patient room/bed information where data exists:
162 .S ORQMORE=$P($G(^DPT(ORQPIEN,.101)),U)
163 .;
164 .; Assure at least 4 letters for any existing room/bed data:
165 .I ORQMORE'="" D ; Any data now?
166 ..I $L(ORQMORE)<4 D ; Less than 4 now?
167 ...S ORQMORE=ORQMORE_" " ; Add 3 for safety.
168 ...S ORQMORE=$E(ORQMORE,1,4) ; Get first 4 only.
169 .;
170 .; Get clinic appointment information, if applicable:
171 .I ORQTYP="C" D
172 ..S ORQMORE="" ; Reset, re-use.
173 ..S ORQMORE=$P(ORQPDAT,U,4) ; App't data.
174 ..S ORQIDT=ORQMORE ; Internal format.
175 ..S $P(ORQMORE,".",2)=$E($P(ORQMORE,".",2)_"000",1,4)
176 ..S ORQMORE=$$FMTE^XLFDT($P(ORQMORE,U)) ; Format app't.
177 ..S ORQPSTAT=$P(ORQPDAT,U,9) ; Ipt/Opt status.
178 .;
179 .; Write a sorted entry in ^TMP("OR",$J,"PATIENTS","B"):
180 .; (Node's data:)
181 .; (DFN^PtName^SSN^DOB^SourceName^App't/Room/Bed^SourceIEN^IOStat)
182 .I ORQPIEN'="" D
183 ..;
184 ..; Write using source name first if sorted by "S" (source) -or-
185 ..; if "P" (app't) sort and not a clinic:
186 ..I ((SORT="S")!((SORT="P")&(ORQTYP'="C"))) D Q
187 ...S ^TMP("OR",$J,"PATIENTS","B",ORQSNM_" "_ORQPNM_" "_ORQPIEN_" "_ORQIDT)=ORQPIEN_U_ORQPNM_U_ORQSSN_U_ORQDOB_U_ORQSNM_U_ORQMORE_U_ORQPTR_U_ORQIDT_U_ORQPSTAT
188 ..;
189 ..; Use source source+app't first if "P" (app't) sort, and a clinic:
190 ..I ((ORQTYP="C")&(SORT="P")) D Q
191 ...S ^TMP("OR",$J,"PATIENTS","B",ORQSNM_" "_ORQIDT_" "_ORQPNM_" "_ORQPIEN)=ORQPIEN_U_ORQPNM_U_ORQSSN_U_ORQDOB_U_ORQSNM_U_ORQMORE_U_ORQPTR_U_ORQIDT_U_ORQPSTAT
192 ..;
193 ..; If not by source or source/app't, default to alpha ("A") sort:
194 ..S ^TMP("OR",$J,"PATIENTS","B",ORQPNM_" "_ORQPIEN_" "_ORQSNM_" "_ORQIDT)=ORQPIEN_U_ORQPNM_U_ORQSSN_U_ORQDOB_U_ORQSNM_U_ORQMORE_U_ORQPTR_U_ORQIDT_U_ORQPSTAT
195 .;
196 .S ORQCNT=ORQCNT+1 ; Increment counter.
197 ;
198 Q
199 ;
200ID(ORQPIEN) ; Return short ID for patient ID.
201 ; (Copied from ORQPT routine and modified.)
202 ;
203 N ID
204 ;
205 S ID=$P($G(^DPT(ORQPIEN,.36)),U,4) ; Gets short ID.
206 I '$L(ID) D ; - or -
207 .S ID=$E($P($G(^DPT(ORQPIEN,0)),U,9),6,9) ; Last 4 of SSN
208 ;
209 Q "("_$E(ORQPNM)_ID_")"
210 ;
Note: See TracBrowser for help on using the repository browser.