source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQPTQ5.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1DGQPTQ5 ; SLC/PKS - Functions for Patient Selection Lists. ; 6/5/01 12:37pm
2 ;;5.3;Registration;**447**;Aug 13, 1993
3 ;
4 Q
5 ;
6COMBDISP(DGQDUZ,DGQPTR) ; Display user's "Combination" pt selection sources.
7 ;
8 ; Variables used:
9 ;
10 ; DGQCNT = Counter for number of entries displayed.
11 ; DGQDUZ = DUZ of user involved.
12 ; DGQPTR = IEN for user's OE/RR PT SEL COMBO file entries.
13 ; DGQSRC = $O command values from combo entries, file ^OR(100.24,.
14 ; DGQTXT = Text name string for combo entry pointers.
15 ;
16 N DGQCNT,DGQSRC,DGQTXT
17 ;
18 ; Check passed variables, punt on errors:
19 S DGQCNT=0
20 I '($D(DGQDUZ)) W !,"No user DUZ passed.",! Q DGQCNT
21 I '($D(DGQPTR)) W !,"No combination pointer passed.",! Q DGQCNT
22 I DGQDUZ="" W !,"No user DUZ passed.",! Q DGQCNT
23 I DGQPTR="" W !,"No combination pointer passed.",! Q DGQCNT
24 ;
25 ; Order through the user's combination source entries:
26 K ^TMP("DG",$J,"DGQCPL")
27 S DGQSRC=0
28 F S DGQSRC=$O(^OR(100.24,DGQPTR,.01,DGQSRC)) Q:'ORQSRC D
29 .;
30 .; Get the actual source name based on the pointer entry value:
31 .S DGQTXT=""
32 .S DGQTXT=$G(^OR(100.24,DGQPTR,.01,DGQSRC,0))
33 .I '(DGQTXT="") D
34 ..S DGQCNT=DGQCNT+1 ; Increment counter.
35 ..S DGQTXT=$$COMBNM(DGQTXT) ; Call tag to create complete string.
36 ..;
37 ..; Write to ^TMP file for sorting:
38 ..I DGQTXT'="" S ^TMP("DG",$J,"DGQCPL",$P(DGQTXT,U))=$P(DGQTXT,U,2)
39 ;
40 ; Write data to the screen:
41 I DGQCNT D ; Data to write?
42 .S DGQTXT="" ; Reset, re-use.
43 .F S DGQTXT=$O(^TMP("DG",$J,"DGQCPL",DGQTXT)) Q:DGQTXT="" D
44 ..W !,$G(^TMP("DG",$J,"DGQCPL",DGQTXT))
45 ;
46 K ^TMP("OR",$J,"DGQCPL") ; Clean house.
47 ;
48 Q DGQCNT ; Return counter.
49 ;
50COMBNM(DGQVAL) ; 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 ; DGQFILE = File for retrieval of name.
63 ; DGQPTR = Name string to return.
64 ; DGQRTN = Value returned by this function.
65 ; DGQVAL = Combo source entry pointer.
66 ;
67 N DGQPTR,DGQFILE,DGQRTN
68 I '($D(DGQVAL)) Q DGQRTN ; Error - punt.
69 ;
70 S DGQRTN="No source found...." ; Default init.
71 S DGQPTR=$P(DGQVAL,";") ; Get pointer.
72 S DGQFILE="^"_$P(DGQVAL,";",2) ; Get file.
73 ;
74 I DGQFILE="^DIC(42," D Q DGQRTN ; Wards.
75 .S DGQRTN=$G(^DIC(42,DGQPTR,0))
76 .I $D(DGQRTN) S DGQRTN="W"_"_"_$P(DGQRTN,U)_U_"Ward: "_$P(DGQRTN,U)_" "_$P(DGQRTN,U,2)
77 ;
78 I DGQFILE="^VA(200," D Q DGQRTN ; Providers.
79 .S DGQRTN=$G(^VA(200,DGQPTR,0))
80 .I $D(DGQRTN) S DGQRTN="P"_"_"_$P(DGQRTN,U)_U_"Provider: "_$P(DGQRTN,U)
81 ;
82 I DGQFILE="^DIC(45.7," D Q DGQRTN ; Specialties.
83 .S DGQRTN=$G(^DIC(45.7,DGQPTR,0))
84 .I $D(DGQRTN) S DGQRTN="S"_"_"_$P(DGQRTN,U)_U_"Specialty: "_$P(DGQRTN,U)
85 ;
86 I DGQFILE="^OR(100.21," D Q DGQRTN ; Team Lists.
87 .S DGQRTN=$G(^OR(100.21,DGQPTR,0))
88 .I $D(DGQRTN) S DGQRTN="T"_"_"_$P(DGQRTN,U)_U_"Team List: "_$P(DGQRTN,U)
89 ;
90 I DGQFILE="^SC(" D Q DGQRTN ; Clinics.
91 .S DGQRTN=$G(^SC(DGQPTR,0))
92 .I $D(DGQRTN) S DGQRTN="C"_"_"_$P(DGQRTN,U)_U_"Clinic: "_$P(DGQRTN,U)
93 ;
94 ; Return value (null will be returned if nothing matched):
95 Q DGQRTN
96 ;
97PTSCOMBO(DGQTYP,DGQPTR) ; Write ^TMP("DG",$J,"PATIENTS","B") patient entries.
98 ;
99 ; Called from COMBPTS^DGQPTQ6.
100 ; (DGQCNT,DGQPDAT,DGQPIEN,DGQPNM,SORT new'd in calling code.)
101 ; (Array DGY new'd in calling routine DGQPTQ2.)
102 ;
103 ; Variables used:
104 ;
105 ; DGQDOB = Patient DOB.
106 ; DGQDONE = Flag for end of patient records.
107 ; DGQIDT = Clinic app't date stored in internal format.
108 ; DGQMORE = Room/bed or appointment information.
109 ; DGQPTR = PASSED: Pointer from subfile entry, combination file.
110 ; DGQSNM = Name of source from subfile entry pointer.
111 ; DGQSNM4 = First four letters of name of source.
112 ; DGQSSN = Patient SSN suffix.
113 ; DGQTYP = PASSED: Holds source type:
114 ;
115 ; W = Ward
116 ; P = Provider
117 ; S = Specialty
118 ; T = Team List
119 ; C = Clinic
120 ;
121 N DGQDOB,DGQDONE,DGQIDT,DGQMORE,DGQSNM,DGQSNM4,DGQSSN
122 ;
123 ; Initialize variables:
124 S DGQDONE=0
125 S DGQCNT=1
126 ;
127 ; Get name data for source:
128 S DGQSNM4="" ; Default setting.
129 I DGQTYP="W" S DGQSNM4=$G(^DIC(42,DGQPTR,0)) ; Wards.
130 I DGQTYP="P" S DGQSNM4=$G(^VA(200,DGQPTR,0)) ; Providers.
131 I DGQTYP="S" S DGQSNM4=$G(^DIC(45.7,DGQPTR,0)) ; Specialties.
132 I DGQTYP="T" S DGQSNM4=$G(^OR(100.21,DGQPTR,0)) ; Team Lists.
133 I DGQTYP="C" S DGQSNM4=$G(^SC(DGQPTR,0)) ; Clinics.
134 ;
135 ; Assure use of first 4 letters of name:
136 S DGQSNM4=$P(DGQSNM4,U)_" " ; Add 4 for safety.
137 S DGQSNM4=$E(DGQSNM4,1,4) ; Get first 4 only.
138 ;
139 ; Add label prefix to source name:
140 S DGQSNM="" ; Default setting.
141 S DGQSNM=$S(DGQTYP="W":"Wd ",DGQTYP="P":"Pr ",DGQTYP="S":"Sp ",DGQTYP="T":"Tm ",DGQTYP="C":"Cl ",1:" ") ; Get correct name.
142 S DGQSNM=DGQSNM_DGQSNM4 ; Prepend label.
143 ;
144 ; Order thru DGY array created by calls in calling routine:
145 S DGQPDAT="" ; Initialize.
146 F S DGQPDAT=$G(DGY(DGQCNT)) Q:((DGQPDAT="")!(DGQDONE)) D
147 .;
148 .; Clear variables each time:
149 .S (DGQPIEN,DGQPNM,DGQSSN,DGQDOB,DGQIDT,DGQMORE)=""
150 .;
151 .S DGQPIEN=$P(DGQPDAT,U) ; Get patient IEN.
152 .I DGQPIEN="" S DGQDONE=1 Q ; Punt if no IEN.
153 .S DGQPNM=$P(DGQPDAT,U,2) ; Get patient name.
154 .;
155 .; Get patient SSN suffix:
156 .S DGQSSN=$$ID($G(DGQPIEN))
157 .;
158 .; Get patient DOB:
159 .S DGQDOB=$$FMTE^XLFDT($P($G(^DPT(DGQPIEN,0)),U,3))
160 .;
161 .; Get patient room/bed information where data exists:
162 .S DGQMORE=$P($G(^DPT(DGQPIEN,.101)),U)
163 .;
164 .; Assure at least 4 letters for any existing room/bed data:
165 .I DGQMORE'="" D ; Any data now?
166 ..I $L(DGQMORE)<4 D ; Less than 4 now?
167 ...S DGQMORE=DGQMORE_" " ; Add 3 for safety.
168 ...S DGQMORE=$E(DGQMORE,1,4) ; Get first 4 only.
169 .;
170 .; Get clinic appointment information, if applicable:
171 .I DGQTYP="C" D
172 ..S DGQMORE="" ; Reset, re-use.
173 ..S DGQMORE=$P(DGQPDAT,U,4) ; App't data.
174 ..S DGQIDT=DGQMORE ; Internal format.
175 ..S $P(DGQMORE,".",2)=$E($P(DGQMORE,".",2)_"000",1,4)
176 ..S DGQMORE=$$FMTE^XLFDT($P(DGQMORE,U)) ; Format app't.
177 .;
178 .; Write a sorted entry in ^TMP("DG",$J,"PATIENTS","B"):
179 .; (Node's data:)
180 .; (DFN^PtName^SSN^DOB^SourceName^App't/Room/Bed^SourceIEN)
181 .I DGQPIEN'="" D
182 ..;
183 ..; Write using source name first if sorted by "S" (source) -or-
184 ..; if "P" (app't) sort and not a clinic:
185 ..I ((SORT="S")!((SORT="P")&(DGQTYP'="C"))) D Q
186 ...S ^TMP("DG",$J,"PATIENTS","B",DGQSNM_" "_DGQPNM_" "_DGQPIEN_" "_DGQIDT)=DGQPIEN_U_DGQPNM_U_DGQSSN_U_DGQDOB_U_DGQSNM_U_DGQMORE_U_DGQPTR_U_DGQIDT
187 ..;
188 ..; Use source source+app't first if "P" (app't) sort, and a clinic:
189 ..I ((DGQTYP="C")&(SORT="P")) D Q
190 ...S ^TMP("DG",$J,"PATIENTS","B",DGQSNM_" "_DGQIDT_" "_DGQPNM_" "_DGQPIEN)=DGQPIEN_U_DGQPNM_U_DGQSSN_U_DGQDOB_U_DGQSNM_U_DGQMORE_U_DGQPTR_U_DGQIDT
191 ..;
192 ..; If not by source or source/app't, default to alpha ("A") sort:
193 ..S ^TMP("DG",$J,"PATIENTS","B",DGQPNM_" "_DGQPIEN_" "_DGQSNM_" "_DGQIDT)=DGQPIEN_U_DGQPNM_U_DGQSSN_U_DGQDOB_U_DGQSNM_U_DGQMORE_U_DGQPTR_U_DGQIDT
194 .;
195 .S DGQCNT=DGQCNT+1 ; Increment counter.
196 ;
197 Q
198 ;
199ID(DGQPIEN) ; Return short ID for patient ID.
200 ; (Copied from DGQPT routine and modified.)
201 ;
202 N ID
203 ;
204 S ID=$P($G(^DPT(DGQPIEN,.36)),U,4) ; Gets short ID.
205 I '$L(ID) D ; - or -
206 .S ID=$E($P($G(^DPT(DGQPIEN,0)),U,9),6,9) ; Last 4 of SSN
207 ;
208 Q "("_$E(DGQPNM)_ID_")"
209 ;
Note: See TracBrowser for help on using the repository browser.