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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1DGRUADT2 ;ALB/GRR - Logic for editing admit, discharge, or transfer; 7-8-99
2 ;;5.3;Registration;**190,328,373,430**;Aug 13, 1993
3 ;
4EDITADT ; Entry point for generating HL7 ADT messages to the COTS system
5 ; whenever an existing patient movement is edited. Multiple messages
6 ; may be created and sent 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 ; DGPPMDA - Ien of prior movement
13 ; DGQUIET - Flag to suppress read/writes if set
14 ; DGADT - Data array for processing ADT events
15 ; DGTRACE - Debugging parameter
16 ; DGPDIV - Division for prior Ward
17 ; DGCDIV - Division for current Ward
18 ; DGINTEG - Integration Database flag
19 ; 0 - Not Integrated Site
20 ; 1 - Integrated, Single Database
21 ; 2 - Integrated, Multiple Databases
22 ; DGLMT - Last Movement flag
23 ; 1 - Created multiple HL7 transactions
24 ; DGCTRAN - 1 - Changing Transfer data, must move
25 ; prior location to current location
26 ;
27 N DGCTRAN,DGLMT,DGINTEG,DGMOVE
28 S (DGCTRAN,DGLMT)=0
29 D SETVAR^DGRUADT(DGPMA)
30 S DGMOVE=$$MOVETYPE^DGRUADT(DGPMA)
31 S DGINTEG=$$GET1^DIQ(43,1,391.705,"I")
32 ;
33 ; If DGTYPE=6, then this a treating specialty change, check if this isfor
34 ; a provider change.
35 I (DGTYPE=6) D Q
36 . N VAIN,VAINDT
37 . S VAINDT=+DGPMA
38 . D INP^VADPT
39 . I (+VAIN(2)=+$G(DGPMVI(7)))&(+VAIN(11)=+$G(DGPMVI(18))) Q
40 . Q:'$$CHKWARD^DGRUUTL(+$G(DGPMVI(5)))
41 . W:$D(DGTRACE) !,2.6
42 . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGPMVI(5))
43 ;
44 ; If DGTYPE=1, then editing an existing admission
45 I (DGTYPE=1) S DGEVENT="A08" D Q
46 . W:$D(DGTRACE) !,2.1
47 . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))&('$$CHKWARD^DGRUUTL(+$P(DGPMP,"^",6)))
48 . ; Check for ward location change
49 . I $P(DGPMP,"^",6)'=$P(DGPMA,"^",6) D Q
50 . . I $$CHKWARD^DGRUUTL($P(DGPMP,"^",6)) D
51 . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,$P(DGPMP,"^",6))
52 . . Q:'$$CHKWARD^DGRUUTL($P(DGPMA,"^",6))
53 . . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,$P(DGPMA,"^",6))
54 . ; Check for edit to admission date, if edited send A08 with date change
55 . I '(+DGPMA=+DGPMP) D Q
56 . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPMP,"^",6),+DGPMP,"A")
57 . ;If Bed switch, create an A02
58 . I ($P(DGPMA,"^",6)=$P(DGPMP,"^",6)),($P(DGPMA,"^",7)'=$P(DGPMP,"^",7)) D Q
59 . . D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
60 . ; Just need an regular A08
61 . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
62 ;
63 ; If DGTYPE=3, then editing an existing discharge
64 I (DGTYPE=3) S DGEVENT="A08" D Q
65 . N DGTIEN
66 . W:$D(DGTRACE) !,2.3
67 . N DGRU,VAROOT
68 . S VAIP("D")="LAST",VAROOT="DGRU"
69 . D IN5^VADPT
70 . K VAROOT
71 . I $$CHKWARD^DGRUUTL(+DGRU(17,4))&(DGMOVE'=42) D Q ;P-430
72 . . N DGASIH S DGASIH=1 ;p-430
73 . . D BLDMSG^DGRUADT1(DFN,"A03",$G(DGPMDA),+DGRU(17,4)) ;p-430
74 . . N DGIEN S DGIEN=$O(^DGRU(46.14,DFN,1,"B",+$G(DGPM0),0)) Q:DGIEN="" ;p-430
75 . . N DGSTAT S DGSTAT="I" ;p-430
76 . . D UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT) ;p-430
77 . I DGMOVE=47 D Q ;p-430
78 . . N DGTIEN ;p-430
79 . . S DGTIEN=$$FLLTCM^DGRUUTL1(DFN) ;p-430
80 . . Q:DGTIEN="" ;p-430
81 . . S DGRU(17,4)=$P(^DGPM(DGTIEN,0),"^",6,7) ;p-430
82 . . Q:'$$CHKWARD^DGRUUTL(+DGRU(17,4)) ;p-430
83 . . N DGASIH S DGASIH=1 ;p-430
84 . . D BLDMSG^DGRUADT1(DFN,"A03",DGTIEN,+DGRU(17,4))
85 . . N DGIEN S DGIEN=$O(^DGRU(46.14,DFN,1,"B",+$G(DGPM0),0)) Q:DGIEN="" ;p-373
86 . . N DGSTAT S DGSTAT="I" ;p-373
87 . . D UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT) ;p-373
88 .; Q:'$$CHKWARD^DGRUUTL(+DGRU(17,4)) p-430
89 . ; Check for edit to discharge date, if edited send modified a08
90 . I '(+DGPMA=+DGPMP) D Q
91 . . I DGMOVE=42 D Q ;p-373
92 . . . N DGNOW D NOW^%DTC S DGNOW=% ;p-373
93 . . . I +$G(DGPMP)<DGNOW D ;p-373
94 . . . . N DGASIH S DGASIH=3 ;p-373
95 . . . . N DGTIEN S DGTIEN=$$FLLTCM^DGRUUTL1(DFN) Q:DGTIEN="" ;p-430
96 . . . . D BLDMSG^DGRUADT1(DFN,"A13",DGTIEN,+^DGPM(DGTIEN,0),+$P(^DGPM(DGTIEN,0),"^",6)) ;p-430
97 . . . . N DGSTAT,DGIEN S DGSTAT="A" ;p-373
98 . . . . S DGIEN=$O(^DGRU(46.14,DFN,1,"B",+$G(DGPM0),0)) Q:DGIEN="" ;p-373
99 . . . . D UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT) ;p-373
100 . . Q:'$$CHKWARD^DGRUUTL(+DGRU(17,4)) ;p-430
101 . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGRU(17,4),+DGPMP,"D")
102 . E D
103 . . Q:'$$CHKWARD^DGRUUTL(+DGRU(17,4)) ;p-430
104 . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGRU(17,4))
105 ;
106 ; If DGTYPE=2, then editng an existing transfer
107 I (DGTYPE=2) S DGEVENT="A08" D Q
108 . W:$D(DGTRACE) !,2.2
109 . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
110 . S DGLMT=0
111 . I $$CHKWARD^DGRUUTL($P(DGPMP,"^",6)) D
112 . . Q:DGINTEG'=1&(DGINTEG'=2) ;Not an integrated database
113 . . Q:'$D(DGPM0) ;No prior movements
114 . . Q:'$$CHKWARD^DGRUUTL($P(DGPM0,"^",6)) ;Not RAI/MDS ward
115 . . I +$$GETDIV^DGRUUTL1($P(DGPMP,"^",6))'=+$$GETDIV^DGRUUTL1($P(DGPM0,"^",6)) D ;Multiple transactions done last time
116 . . . S DGLMT=1
117 . ;
118 . I $P(DGPMP,"^",6)'=$P(DGPMA,"^",6) D Q ;Ward changed
119 . . I +$$GETDIV^DGRUUTL1($P(DGPMP,"^",6))'=+$$GETDIV^DGRUUTL1($P(DGPMA,"^",6)) D
120 . . . I +$$GETDIV^DGRUUTL1($P(DGPMA,"^",6))=+$$GETDIV^DGRUUTL1($P(DGPM0,"^",6)) D ;now same division as original ward, cancel dc and admit, send A02
121 . . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
122 . . . . S DGCTRAN=1 D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
123 . . . . D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
124 . . . E D
125 . . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
126 . . . . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
127 . . E D
128 . . . S DGCTRAN=1
129 . . . I 'DGLMT D
130 . . . . D BLDMSG^DGRUADT1(DFN,"A12",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
131 . . . . D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
132 . . . E D
133 . . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
134 . . . . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
135 . . . . I +DGPMP'=+DGPMA D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPMP,"^",6),+DGPMP,"D") ;date also changed, update discharge date in other entity
136 . ;
137 . ; Check for edit to transfer date, if edited send modified A08
138 . I '(+DGPMA=+DGPMP) D Q
139 . . I 'DGLMT D ;Just send one A08 to change transfer date
140 . . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPMP,"^",6),+DGPMP,"T")
141 . . E D
142 . . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPMP,"^",6),+DGPMP,"A")
143 . . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPM0,"^",6),+DGPMP,"D")
144 . E D
145 . . ; The following checks for the special case of a bed switch following a transfer
146 . . ; in the movement sequence. Bed switch requires an "A02"
147 . . I ($P(DGPMA,"^",6)=$P(DGPMP,"^",6)),($P(DGPMA,"^",7)'=$P(DGPMP,"^",7)) D
148 . . . D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
149 . . E D ; Process straight interward transfer with no special cases
150 . . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
151 ;
152EXIT Q
Note: See TracBrowser for help on using the repository browser.