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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1DGQPTQ6 ; SLC/PKS - Combination pt. list cont. ;6/5/01 12:38pm
2 ;;5.3;Registration;**447**;Aug 13, 1993
3 ;
4 ; Called by BUILD^DGQPT
5 ;
6 Q
7 ;
8COMBPTS(DGQLM,DGQCPTR,DGBDATE,DGEDATE) ; Build "Combination" pt. list.
9 ; SLC/PKS.
10 ;
11 ; NOTE: Any calls to this tag need to deal with DGQLM passed
12 ; variable appropriately. Notice where it is evaluated
13 ; and make sure code specifies the setting of DGQLM (a
14 ; boolean variable) properly for the call.
15 ;
16 ; Variables used:
17 ;
18 ; MSG = Holds error message, if any.
19 ; DGBDATE = PASSED: Beginning date for clinic appointments.
20 ; DGEDATE = PASSED: End date for clinic appointments.
21 ; DGQCNT = Counter for patients.
22 ; DGQCPTR = PASSED: Combination file [^OR(100.24,] pointer.
23 ; DGQDUZ = DUZ of current user.
24 ; DGQERR = Array for error msg(s) return from DB calls.
25 ; DGQFILE = Combo source entry file.
26 ; DGQLM = PASSED: Called from LM ("1") or GUI ("0")?
27 ; DGQPDAT = String holder for arrays and ^TMP file values.
28 ; DGQPDOB = Patient DOB.
29 ; DGQPFMDT = Hold app't date/time in FM internal format.
30 ; DGQPIEN = Variable for patient IEN, ^TMP("DG",$J,"PTSCOMBO")
31 ; DGQPMOR = Appointment or Room/Bed information.
32 ; DGQPNM = Variable for patient name, ^TMP("DG",$J,"PTSCOMBO")
33 ; DGQPSNM = Source name display string holder.
34 ; DGQPSSN = Patient ID (first letter of last name, last 4 SSN).
35 ; DGQPTMP = Temporary string construction holder.
36 ; DGQPTR = Pointer to combo source entry.
37 ; DGQRTN = Holds return value from DB calls.
38 ; DGQSPCH = Holds return value from SELCHK^DGWPT.
39 ; DGQSRC = Variable to hold each combo source subscript.
40 ; DGQSRCID = IEN of source.
41 ; DGQTXT = Variable to hold stored values.
42 ; DGY = Array used in sub-calls.
43 ;
44 ; (NOTE: LCNT,LIST,MSG,NUM,SORT new'd in calling routines for LM.)
45 ;
46 N DGQCNT,DGQDUZ,DGQERR,DGQFILE,DGQPCNT,DGQPDAT,DGQPDOB,DGQPFMDT,DGQPIEN,DGQPNM,DGQPMOR,DGQPSNM,DGQPSSN,DGQPTMP,DGQPTR,DGQRTN,DGQSPCH,DGQSRC,DGQSRCID,DGQTXT,DGY
47 ;
48 K ^TMP("DG",$J,"PATIENTS") ; Safety cleanup.
49 ;
50 ; Do preliminary settings, cleanup, look for an existing user record:
51 S MSG="" ; Default.
52 I '$D(DUZ) D
53 .S MSG="No user DUZ info."
54 .I 'DGQLM D GUIABORT
55 .Q
56 S DGQDUZ=DUZ
57 K DGQERR
58 S DGQRTN=$$FIND1^DIC(100.24,"","QX",DGQDUZ,"","","DGQERR")
59 K DGQERR
60 D CLEAN^DILF ; Clean up after DB call.
61 ;
62 ; If no combination record, then punt:
63 I +DGQRTN<1 D
64 .S MSG="No combination entry."
65 .I 'DGQLM D GUIABORT
66 .Q
67 ;
68 I DGQLM D CLEAN^VALM10 ; VALM housekeeping.
69 ;
70 ; Order through the user's combination source entries:
71 I 'DGQLM S SORT="A" ; Required variable for PTSCOMBO^ORQPTQ5.
72 S DGQSRC=0
73 F S DGQSRC=$O(^OR(100.24,DGQRTN,.01,DGQSRC)) Q:'DGQSRC D
74 .K DGY ; Clean up each time.
75 .S DGQTXT="" ; Initialize.
76 .S DGQTXT=$G(^OR(100.24,DGQRTN,.01,DGQSRC,0)) ; Get record's value.
77 .;
78 .; In case of error, punt:
79 .I DGQTXT="" D
80 ..S MSG="Combination source entry error."
81 ..I 'DGQLM D GUIABORT ; GUI is different.
82 ..Q
83 .I DGQTXT="" Q
84 .S DGQPTR=$P(DGQTXT,";") ; Get pointer.
85 .S DGQFILE="^"_$P(DGQTXT,";",2) ; Get file.
86 .;
87 .; Get info for each source entry and build DGY array accordingly.
88 .I DGQFILE="^DIC(42," D Q ; Wards.
89 ..D WARDPTS^DGQPTQ2(.DGY,DGQPTR)
90 ..I $D(DGY) D PTSCOMBO^DGQPTQ5("W",DGQPTR) ; Process DGY array.
91 .I DGQFILE="^VA(200," D Q ; Providers.
92 ..D PROVPTS^DGQPTQ2(.DGY,DGQPTR)
93 ..I $D(DGY) D PTSCOMBO^DGQPTQ5("P",DGQPTR) ; Process DGY array.
94 .I DGQFILE="^DIC(45.7," D Q ; Specialties.
95 ..D SPECPTS^DGQPTQ2(.DGY,DGQPTR)
96 ..I $D(DGY) D PTSCOMBO^DGQPTQ5("S",DGQPTR) ; Process DGY array.
97 .I DGQFILE="^OR(100.21," D Q ; Team Lists
98 ..D TEAMPTS^DGQPTQ1(.DGY,DGQPTR)
99 ..I $D(DGY) D PTSCOMBO^DGQPTQ5("T",DGQPTR) ; Process DGY array.
100 .I DGQFILE="^SC(" D Q ; Clinics.
101 ..D CLINPTS^DGQPTQ2(.DGY,DGQPTR,DGBDATE,DGEDATE)
102 ..I $D(DGY) D PTSCOMBO^DGQPTQ5("C",DGQPTR) ; Process DGY array.
103 ;
104 ; Order thru ^TMP file "B" node entries returned by previous calls:
105 S DGQCNT=0 ; Reset for final use.
106 I $D(^TMP("DG",$J,"PATIENTS")) D
107 .S DGQPDAT=""
108 .F S DGQPDAT=$O(^TMP("DG",$J,"PATIENTS","B",DGQPDAT)) Q:DGQPDAT="" D
109 ..;
110 ..; Clear variables each time through:
111 ..S (DGQTXT,DGQPFMDT,DGQPIEN,DGQPNM,DGQPSSN,DGQPDOB,DGQPSNM,DGQPMOR,DGQSRCID)=""
112 ..;
113 ..; Retrieve node's value:
114 ..S DGQTXT=$G(^TMP("DG",$J,"PATIENTS","B",DGQPDAT))
115 ..;
116 ..; Set indvidual variables:
117 ..S DGQPIEN=$P(DGQTXT,U) ; Patient DFN.
118 ..S DGQPNM=$P(DGQTXT,U,2) ; Patient name.
119 ..S DGQPSSN=$P(DGQTXT,U,3) ; Patient ID.
120 ..S DGQPDOB=$P(DGQTXT,U,4) ; Patient DOB.
121 ..S DGQPSNM=$P(DGQTXT,U,5) ; Source data.
122 ..S DGQPMOR=$P(DGQTXT,U,6) ; App't or R/B info.
123 ..S DGQSRCID=$P(DGQTXT,U,7) ; Source IEN.
124 ..S DGQPFMDT=$P(DGQTXT,U,8) ; App't FM date/time.
125 ..S DGQCNT=DGQCNT+1 ; Increment counter.
126 ..;
127 ..; If a "sensitive" patient, reassign SSN, DOB data:
128 ..S DGQSPCH=$$SSN^DPTLK1(DGQPIEN)
129 ..I DGQSPCH["*" S DGQPSSN=""
130 ..S DGQPDOB=$$DOB^DPTLK1(DGQPIEN)
131 ..;
132 ..; Make some preliminary data settings:
133 ..S DGQPTMP=""
134 ..I DGQPSNM'="" S DGQPTMP=DGQPSNM_" "
135 ..S DGQPTMP=DGQPTMP_DGQPMOR
136 ..;
137 ..; Write new ^TMP file "PATIENTS" nodes:
138 ..I DGQLM D ; For LM.
139 ...S ^TMP("DG",$J,"PATIENTS","IDX",DGQCNT)=DGQPIEN_U_DGQPNM
140 ...S ^TMP("DG",$J,"PATIENTS",DGQCNT,0)=$$LJ^XLFSTR(DGQCNT,5)_$$LJ^XLFSTR(DGQPNM,31)_$$LJ^XLFSTR(DGQPSSN,10)_$$LJ^XLFSTR(DGQPDOB,15)_DGQPTMP_$$LJ^XLFSTR(DGQPDOB,15)_$$RJ^XLFSTR(DGQSRCID,8)_" "_DGQPFMDT
141 ...D CNTRL^VALM10(DGQCNT,1,5,IOINHI,IOINORM)
142 ..;
143 ..I 'DGQLM D ; For GUI.
144 ...S DGQTXT=DGQPIEN_U_DGQPNM_U_DGQPSNM_U_DGQPMOR_U_DGQPSSN_U_DGQPDOB_U_DGQSRCID_U_DGQPFMDT
145 ...S ^TMP("DG",$J,"PATIENTS",DGQCNT,0)=DGQTXT ; Actual global write.
146 ;
147 ; Set counters for return, if applicable; do cleanup:
148 I DGQCNT S (LCNT,NUM)=DGQCNT
149 K DGY
150 ;
151 ; If no patients found, prepare user message:
152 I 'DGQCNT S MSG="No patients found."
153 ;
154 ; If an error message exists, dump any partial processing and quit:
155 I MSG'="" D Q
156 .I 'DGQLM D GUIABORT
157 .I DGQLM K ^TMP("DG",$J,"PATIENTS")
158 ;
159 ; Next lines create #line^^#pts^context value entry:
160 I DGQLM D
161 .S ^TMP("DG",$J,"PATIENTS",0)=DGQCNT_U_DGQCNT_U_$G(LIST)
162 .S ^TMP("DG",$J,"PATIENTS","#")=$O(^ORD(101,"B","ORQPT SELECT PATIENT",0))_"^1:"_DGQCNT
163 ;
164 ; Standard clean-up for GUI:
165 I 'DGQLM D
166 .K LCNT,LIST,MSG,NUM,SORT
167 .K ^TMP("DG",$J,"PATIENTS","B")
168 ;
169 Q
170 ;
171GUIABORT ; Cleanup when aborting when called from GUI.
172 ;
173 K ^TMP("DG",$J,"PATIENTS")
174 S ^TMP("DG",$J,"PATIENTS",0)=""
175 K LCNT,LIST,MSG,NUM,SORT
176 ;
177 Q
178 ;
Note: See TracBrowser for help on using the repository browser.