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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1DGRRPSAD ; ALB/SGG - rtnDGRR PatientServices ADT Information ;09/30/03 ; Compiled December 9, 2003 15:22:22
2 ;;5.3;Registration;**557**;Aug 13, 1993
3 ;
4DOC ;<DataSet Name='ADT'
5 ;
6 ;.102 CURRENT MOVEMENT (*P405'), [.102;1]
7 ; FILE (#405) PATIENT MOVEMENT STORED IN: ^DGPM(
8 ; .01 DATE/TIME (RDX), [0;1]
9 ;
10 ;.1 WARD LOCATION (FX), [.1;E1,30]
11 ;.101 ROOM-BED (F), [.101;1]
12 ;.103 TREATING SPECIALTY (P45.7'), [.103;1]
13 ;.104 PROVIDER (*P200'), [.104;1]
14 ;.1041 ATTENDING PHYSICIAN (*P200'), [.1041;1]
15 ;.105 CURRENT ADMISSION (*P405'), [.105;1]
16 ;.107 LODGER WARD LOCATION (F), [.107;1] ; LODGER ONLY
17 ;.108 CURRENT ROOM (P405.4'), [.108;1] ; LODGER ONLY
18 ; ^DG(405.4
19 ; PREVIOUS DISCHARGE DATE ; NON CURRENT NON LODGER
20 ;
21 ;
22 ;A DIFFERENT LOGIC HAS BEEN ADOPTED FOR THE ADT DATASET
23 ;
24 ;USING IN5^VADPT:
25 ; first CALL IN5^VADPT for CURRENT INFO based on the requested
26 ; date passed to RPC. If no date sent, defaults to current date.
27 ; if no CURRENT CALL IN5^VADPT for LODGER INFO
28 ; if no LODGER INFO CALL IN5^VADPT for LAST DISCHARGE DATE
29 ;
30 ;Rows of ADT movements associated with the admission are also returned.
31 ;See BLD for list of data elements returned for each movement.
32 ;
33GETPSARY(PSARRAY,REQDT) ;
34 ;
35 ; GET CURRENT MOVEMENT DATA FROM IN5^VADPT
36 NEW INDATA,VAIP,VAINDT,DFN,VAROOT,VAHOW,ADTTYPE
37 SET DFN=PTID
38CURRENT K INDATA,VAIP,VAINDT
39 SET VAROOT="INDATA",VAHOW=2
40 DO IN5^VADPT SET ADTTYPE="CURRENT"
41LODGER IF $P($G(INDATA(1)),"^",1)="" DO ; NO CURRENT DO LODGER
42 .KILL INDATA,VAIP,VAINDT
43 .SET VAROOT="INDATA",VAHOW=2,VAIP("L")=""
44 .DO IN5^VADPT SET ADTTYPE="LODGER"
45LAST IF $P($G(INDATA(1)),"^",1)="" DO ; NO CURRENT AND NO LODGER DO PREVIOUS
46 .K INDATA,VAIP,VAINDT
47 .SET VAROOT="INDATA",VAHOW=2,VAIP("D")="LAST"
48 .DO IN5^VADPT SET ADTTYPE="DISCHARGE"
49 ;
50 NEW CNT
51 SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='ADT'"
52 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RequestDate^"_DT
53 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^CurrentMovement^"_$$CURMOVE()
54 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WardLocation^"_$$WARDLOC()
55 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Service^"_$$SERVICE()
56 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RoomBed^"_$$ROOMBED()
57 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^TreatingSpecialty^"_$$TRETSPC()
58 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Provider^"_$$PROVIDE()
59 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^AttendingPhysician^"_$$ATTPHY()
60 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^CurrentAdmission^"_$$CURADM()
61 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^TransactionType^"_$$TRANSTYP()
62 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MovementType^"_$$MVTTYP()
63 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LastAdmissionDate^"_$$LASTADM()
64 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LodgerWardLocation^"_$$LODWLOC()
65 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LodgerRoom^"_$$LODROOM()
66 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DischargeDate^"_$$DISDATE()
67 D ADTC(REQDT,.CNT)
68 SET CNT=$G(CNT)+1,PSARRAY(CNT)="></DataSet>"_"^^^1"
69 QUIT
70 ;
71ADTC(ADTDT,CNT) ;ADT Collection of all movements associated with a specifed date
72 NEW ROWCNT
73 K VAIP,VAROOT,INDATA,VAHOW
74 SET ADTDT=$S($G(ADTDT)'="":ADTDT\1,1:DT)
75 SET ROWCNT=0
76 SET VAIP("D")=ADTDT
77 SET VAIP("M")=0
78 SET VAIP("L")=""
79 DO IN5^VADPT
80 IF VAIP(1)'="" DO
81 . NEW DGRRMIEN,DGRRCA,DGRRMVDT
82 . SET DGRRCA=VAIP(1)
83 . K ^TMP($J,"DGRRMVTS")
84 . SET DGRRMIEN=""
85 . F SET DGRRMIEN=$O(^DGPM("CA",+DGRRCA,DGRRMIEN)) Q:DGRRMIEN="" D
86 ..; Set up TMP global to assure movements are in date/time order
87 ..S DGRRMVDT=+$P($G(^DGPM(+DGRRMIEN,0)),"^")
88 ..I DGRRMVDT>0 S ^TMP($J,"DGRRMVTS",DGRRMVDT,DGRRMIEN)=""
89 . ;Loop through TMP global
90 .N DGRRMDT,DGRRIEN
91 .S DGRRMDT=""
92 .F S DGRRMDT=$O(^TMP($J,"DGRRMVTS",DGRRMDT)) Q:DGRRMDT="" D
93 .. S DGRRIEN=""
94 .. F S DGRRIEN=$O(^TMP($J,"DGRRMVTS",DGRRMDT,DGRRIEN)) Q:DGRRIEN="" D
95 ... K INDATA,VAROOT,VAIP
96 ... SET ROWCNT=$G(ROWCNT)+1
97 ... SET VAIP("E")=DGRRIEN
98 ... SET VAROOT="INDATA"
99 ... DO IN5^VADPT
100 ... S ADTTYPE=$S(+$G(INDATA(2))=4!(+$G(INDATA(2))=5):"LODGER",+$G(INDATA(2))=3:"DISCHARGE",1:"CURRENT")
101 ... DO BLD
102 .K ^TMP($J,"DGRRMVTS")
103 IF ROWCNT=0 D
104 .SET ROWCNT=ROWCNT+1
105 .DO BLD
106 Q
107 ;
108BLD ;Build array of data elements for each movement. Similar to elements
109 ;defined for current inpatient and lodger activity. The word 'current'
110 ;removed from element names.
111 ;
112 SET CNT=$G(CNT)+1,PSARRAY(CNT)="><ADTMovements Row='"_ROWCNT_"'"
113 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RequestDate^"_ADTDT
114 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MovementDate^"_$$CURMOVE()
115 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WardLocation^"_$$WARDLOC()
116 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Service^"_$$SERVICE()
117 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RoomBed^"_$$ROOMBED()
118 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^TreatingSpecialty^"_$$TRETSPC()
119 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Provider^"_$$PROVIDE()
120 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^AttendingPhysician^"_$$ATTPHY()
121 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^AdmissionDate^"_$$CURADM()
122 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^TransactionType^"_$$TRANSTYP()
123 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MovementType^"_$$MVTTYP()
124 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LodgerWardLocation^"_$$LODWLOC()
125 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LodgerRoom^"_$$LODROOM()
126 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DischargeDate^"_$$DISDATE()
127 SET CNT=$G(CNT)+1,PSARRAY(CNT)="></ADTMovements"
128 Q
129CURMOVE() ;
130 NEW DATA
131 SET DATA=""
132 IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(3)),"^",1)
133 QUIT DATA
134 ;
135WARDLOC() ;
136 NEW DATA
137 SET DATA=""
138 IF ADTTYPE="CURRENT" SET DATA=$P($G(INDATA(5)),"^",2)
139 QUIT DATA
140 ;
141SERVICE() ;
142 NEW DATA
143 SET DATA=""
144 IF ADTTYPE="CURRENT" SET DATA=$P($G(INDATA(5)),"^",1)
145 IF ADTTYPE="CURRENT" SET DATA=$P($G(^DIC(42,+DATA,0)),"^",3)
146 IF ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(17,4)),"^",1)
147 IF ADTTYPE="DISCHARGE" SET DATA=$P($G(^DIC(42,+DATA,0)),"^",3)
148 QUIT DATA
149 ;
150ROOMBED() ;
151 NEW DATA
152 SET DATA=""
153 IF ADTTYPE="CURRENT" SET DATA=$P($G(INDATA(6)),"^",2)
154 QUIT DATA
155 ;
156TRETSPC() ;
157 NEW DATA
158 SET DATA=""
159 IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(8)),"^",2)
160 QUIT DATA
161 ;
162PROVIDE() ;
163 NEW DATA
164 SET DATA=""
165 IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(7)),"^",2)
166 QUIT DATA
167 ;
168ATTPHY() ;
169 NEW DATA
170 SET DATA=""
171 IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(18)),"^",2)
172 QUIT DATA
173 ;
174CURADM() ;
175 NEW DATA
176 SET DATA=""
177 IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(13,1)),"^",1)
178 QUIT DATA
179 ;
180TRANSTYP() ;
181 NEW DATA
182 SET DATA=""
183 I ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(2)),"^",2)
184 I ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(17,2)),"^",2)
185 QUIT DATA
186 ;
187MVTTYP() ;
188 NEW DATA
189 SET DATA=""
190 I ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(4)),"^",2)
191 I ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(17,3)),"^",2)
192 QUIT DATA
193 ;
194LASTADM() ;
195 NEW DATA
196 SET DATA=""
197 IF ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(13,1)),"^",1)
198 QUIT DATA
199 ;
200LODWLOC() ;
201 NEW DATA
202 SET DATA=""
203 IF ADTTYPE="LODGER" SET DATA=$P($G(INDATA(5)),"^",2)
204 QUIT DATA
205 ;
206LODROOM() ;
207 NEW DATA
208 SET DATA=""
209 IF ADTTYPE="LODGER" SET DATA=$P($G(INDATA(6)),"^",2)
210 QUIT DATA
211 ;
212DISDATE() ;
213 NEW DATA
214 SET DATA=""
215 IF ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(17,1)),"^",1)
216 QUIT DATA
Note: See TracBrowser for help on using the repository browser.