source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUADT.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: 7.5 KB
Line 
1DGRUADT ;ALB/SCK - MAIN DRIVER FOR RAI/MDS ADT MESSAGING; 7-8-99 ; 29 Aug 2006 9:07 AM
2 ;;5.3;Registration;**190,312,328,373,430,464,721**;Aug 13, 1993;Build 3
3 ;
4EN ; Main entry point for generating an HL7 ADT message to the COTS system
5 ; The message builder is tasked off to taskManager to build and transmit
6 ; the ADT message to the vendor.
7 ; Input:
8 ; DGPMP - 0 node of the primary movement BEFORE the ADT action
9 ; DGPMA - 0 node of the primary movement AFTER the ADT action
10 ; DFN - Ien of the patient in the PATIENT File (#2)
11 ; DGPMDA - Ien of the movement
12 ; DGQUIET - Flag to suppress read/writes if set
13 ; DGADT - Data array for processing ADT events
14 ; DGTRACE - Debugging parameter
15 ; DGPDIV - Division for prior Ward
16 ; DGCDIV - Division for current Ward
17 ; DGINTEG - Integration Database flag
18 ; 0 - Not Integrated Site
19 ; 1 - Integrated, Single Database
20 ; 2 - Integrated, Multiple Databases
21 ; DGPMVI - Array where results from call to IN5^VADPT returned
22 ;
23 N DGTRACE,VAFH
24 ;
25 ; Test for ADT on/off parameter
26 Q:'$P($$SEND^VAFHUTL(),"^",2)
27 ;
28 M VAFH=^UTILITY("DGPM",$J)
29 ;
30 I '($G(DGQUIET)) D
31 . W !,"Executing HL7 ADT Messaging (RAI/MDS)"
32 . I $D(^TMP("DGRUADT1")) S DGTRACE=1
33 I $D(DGTRACE) D G EXIT
34 . D INIT
35 ;
36 N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH,X,ZTQUEUED,ZTREQ
37 S ZTDESC="HL7 ADT MESSAGE (RAI/MDS)",ZTRTN="EVENT^DGRUADT"
38 F X="DGPMP","DGPMA","DGPMDA","DFN","DGPMAN","VAFH(" S ZTSAVE(X)=""
39 S ZTIO="",ZTDTH=$H
40 D ^%ZTLOAD
41EXIT ;
42 I $D(ZTQUEUED) S ZTREQ="@"
43 D KILL^HLTRANS
44 K ^TMP("HLS",$J)
45 Q
46 ;
47INIT ;
48 D EVENT,EXIT
49 Q
50 ;
51EVENT ;
52 N DGTYPE,DGMOVE,DGADMSN,VAFHDT,DGEVENT,VAIP
53 ;
54 ; Check for valid movements
55 I $G(DGPMP)=""&($G(DGPMA)="") Q
56 ;
57 ; Determine the event transaction type. The events are:
58 ;
59 ; If DGPMP is null and DGPMA is not, then adding a new ADT event
60 I (DGPMP="")&(DGPMA'="") D G EVENTQ
61 . D SETVAR(DGPMA)
62 . ;
63 . ; If DGTYPE=6, then this a treating specialty change, check if this is for
64 . ; a provider change.
65 . I (DGTYPE=6) D Q
66 . . N VAIN,VAINDT
67 . . S VAINDT=+DGPMA
68 . . D INP^VADPT
69 . . ; I (+VAIN(2)=+$G(DGPMVI(7)))&(+VAIN(11)=+$G(DGPMVI(18))) Q p-721
70 . . Q:'$$CHKWARD^DGRUUTL(+$G(DGPMVI(5)))
71 . . W:$D(DGTRACE) !,1.6
72 . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGPMVI(5))
73 . ;
74 . ; If DGTYPE=1, then it means an admission
75 . I (DGTYPE=1) S DGEVENT="A01" D Q
76 . . W:$D(DGTRACE) !,1.1
77 . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
78 . . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
79 . ;
80 . ; If DGTYPE=3, then it means a discharge
81 . I (DGTYPE=3) S DGEVENT="A03" D Q
82 . . W:$D(DGTRACE) !,1.3
83 . . S DGMOVE=$$MOVETYPE(DGPMA)
84 . . ;
85 . . ;If Movement type "From ASIH" create A22 and send to COTS
86 . . I DGMOVE=41!(DGMOVE=14) D MV41^DGRUADT0(DFN) Q
87 . . ;
88 . . ; Get ward discharged from, if RAI/MDS, then process message
89 . . N VAIP S VAIP("D")="LAST"
90 . . D IN5^VADPT
91 . . ;If Movement type "Death" must check to see if patient was ASIH
92 . . ;If patient was ASIH, create and send A03 to COTS
93 . . I $P($G(DGPMAN),"^",21)]"" N DGASIH D MV1238^DGRUADT0(DFN) Q:$G(DGASIH)=1 ;modified p-373
94 . . ;
95 . . Q:'$$CHKWARD^DGRUUTL(+VAIP(17,4))
96 . . D BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,+VAIP(17,4))
97 . ;
98 . ; If DGTYPE=2, then it means a transfer
99 . I (DGTYPE=2) S DGEVENT="A02" D Q
100 . . W:$D(DGTRACE) !,1.2
101 . . S DGMOVE=$$MOVETYPE(DGPMA)
102 . . ;
103 . . ; If transfer to ASIH
104 . . I DGMOVE=13!(DGMOVE=43)!(DGMOVE=40) D MV40^DGRUADT0(DFN) Q
105 . . ;
106 . . ;If transfer From ASIH
107 . . I DGMOVE=14!(DGMOVE=41) D MV41^DGRUADT0(DFN) Q
108 . . ; If transfer is to Leave of absence
109 . . I DGMOVE=1!(DGMOVE=2)!(DGMOVE=3) D Q ;modified p-328
110 . . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
111 . . . D BLDMSG^DGRUADT1(DFN,"A21",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
112 . . ;
113 . . ; If transfer is from Leave of absence
114 . . I DGMOVE=23!(DGMOVE=24)!(DGMOVE=22) D Q
115 . . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
116 . . . D BLDMSG^DGRUADT1(DFN,"A22",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
117 . . ;
118 . . I DGMOVE=4 D MV4^DGRUADT0(DFN,DGPMA)
119 . ;
120 ;
121 ; If DGPMP and DGPMA are both NOT null, then editing an ADT event
122 I (DGPMP'="")&(DGPMA'="") D EDITADT^DGRUADT2 G EVENTQ
123 ;
124 ; If DGPMP is not null and DGPMA is, then deleting an ADT event
125 I (DGPMP'="")&(DGPMA="") D G EVENTQ
126 . D SETVAR(DGPMP)
127 . S DGMOVE=$$MOVETYPE(DGPMP)
128 . ;
129 . ; If DGTYPE=1, then deleting an admission
130 . I (DGTYPE=1) S DGEVENT="A11" D Q
131 . . W:$D(DGTRACE) !,3.1
132 . . ;Check if deleting an admission for an ASIH event
133 . . I DGMOVE=13!(DGMOVE=43)!(DGMOVE=40) D CN40^DGRUADT0(DFN) Q
134 . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMP,"^",6)) ;Quit if not RAI/MDS ward
135 . . ;
136 . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
137 . ;
138 . ; If DGTYPE=3, then deleting a discharge
139 . I (DGTYPE=3) S DGEVENT="A13" D Q
140 . . W:$D(DGTRACE) !,3.3
141 . . S VAIP("D")="LAST",VAIP("M")=1
142 . . D IN5^VADPT
143 . . ; Get ward. Use last movement if it exists, if not use the current movement.
144 . . N DGWARD S DGWARD=(+VAIP(14,4))
145 . . I $P($G(DGPMAN),"^",21)]"" N DGASIH D Q:$G(DGASIH)=3 ;Deleting discharge which relates to ASIH (312), modified p-373
146 . . . N DGOMDT,DGOWARD,DGOIEN
147 . . . S DGOMDT=+$G(DGPMAN) Q:DGOMDT'>0
148 . . . S DGOMDT=$O(^DGPM("APRD",DFN,DGOMDT),-1) Q:DGOMDT'>0 ;Get movement prior to ASIH
149 . . . S DGOIEN=$O(^DGPM("APRD",DFN,DGOMDT,0)) ;Get IEN of movement
150 . . . S DGOWARD=$$GET1^DIQ(405,DGOIEN,".06","I") Q:DGOWARD=""
151 . . . Q:'$$CHKWARD^DGRUUTL(DGOWARD) ;Quit if not RAI/MDS flag
152 . . . N DGLDDAT S DGLDDAT=$O(^DGPM("APTT3",DFN,""),-1) ;p-430
153 . . . I $G(DGLDDAT)]"",DGLDDAT>+$P($G(DGPMAN),"^"),DGLDDAT<+$G(DGNOW) Q ;p-430
154 . . . K DGLDDAT ;p-430
155 . . . S DGASIH=3 ;Set flag to identify ASIH (used by DGRUGA13)
156 . . . D BLDMSG^DGRUADT1(DFN,"A13",DGOIEN,+DGPMP,DGOWARD)
157 . . . N DGSTAT,DGIEN S DGSTAT="A" ;p-430
158 . . . S DGIEN=$O(^DGRU(46.14,DFN,1,"B",+$G(DGPMAN),0)) Q:DGIEN="" ;p-430
159 . . . D UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT) ;p-430
160 . . S:'DGWARD DGWARD=+VAIP(5)
161 . . Q:'$$CHKWARD^DGRUUTL(DGWARD)
162 . . D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARD)
163 . ;
164 . ; If DGTYPE=2, then deleting a transfer
165 . I (DGTYPE=2) S DGEVENT="A12" D Q
166 . . W:$D(DGTRACE) !,3.2
167 . . N DGWARDP,DGWARDA,VAIP
168 . . S DGWARDP=+$P(DGPMP,"^",6)
169 . . N VAIP S VAIP("D")="LAST",VAIP("M")=1
170 . . D IN5^VADPT
171 . . S DGWARDA=+VAIP(5)
172 . . I 'DGWARDP!('DGWARDA) D Q
173 . . . W !,"Unable to determine wards for transfer cancellation"
174 . . ;
175 . . ;Get Division for prior Ward
176 . . S DGPDIV=+$$GETDIV^DGRUUTL1(DGWARDP)
177 . . ;
178 . . ;Get Division for current Ward
179 . . S DGCDIV=+$$GETDIV^DGRUUTL1(DGWARDA)
180 . . ;
181 . . ;Get Integration flag
182 . . S DGINTEG=+$$GET1^DIQ(43,1,391.705,"I")
183 . . ;
184 . . ; If cancel transfer mds to mds ward: A12
185 . . I $$CHKWARD^DGRUUTL(DGWARDP)&($$CHKWARD^DGRUUTL(DGWARDA)) D Q
186 . . . I DGINTEG=1!(DGINTEG=2),DGPDIV'=DGCDIV D
187 . . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,DGWARDP)
188 . . . . D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARDA)
189 . . . E D ;
190 . . . . D BLDMSG^DGRUADT1(DFN,"A12",DGPMDA,+DGPMP,DGWARDP)
191 . . . . I DGMOVE=43 D DELASIH^DGRUASIH(DFN,VAFHDT) ;p-464
192 . . ; If cancel transfer to non-mds ward from an mds ward: A13
193 . . I '$$CHKWARD^DGRUUTL(DGWARDP)&($$CHKWARD^DGRUUTL(DGWARDA)) D Q
194 . . . D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARDP)
195 . . ; If cancel transfer to mds ward from an non-mds ward: A11
196 . . I $$CHKWARD^DGRUUTL(DGWARDP)&('$$CHKWARD^DGRUUTL(DGWARDA)) D Q
197 . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,DGWARDP)
198 ;
199EVENTQ Q
200 ;
201SETVAR(NODE) ;
202 S DGTYPE=$P(NODE,"^",2),VAFHDT=$P(NODE,"^",1),DGADMSN=$P(NODE,"^",14)
203 Q
204 ;
205MOVETYPE(NODE) ;
206 N TYPE
207 S TYPE=$P(NODE,"^",18)
208 Q +$G(TYPE)
Note: See TracBrowser for help on using the repository browser.