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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1DGRUADT0 ;ALB/GRR - INTEGRATED SITE PROCESSING FOR RAI/MDS ADT MESSAGING; 7-8-99
2 ;;5.3;Registration;**190,312,328**;Aug 13, 1993
3 ;
4MV4(DFN,DGPMA) ;
5 N VAIP,DGWDP,DGWDA,DGPDIV,DGCDIV,DGINTEG
6 ;
7 ; Variables
8 ; VAIP - Patient Data array from lookup utility
9 ; DGWDP - Ward prior to the transfer
10 ; DGWDA - Ward after the transfer
11 ; DGPDIV - Division of Ward prior to transfer
12 ; DGCDIV - Division of Ward after transfer
13 ; DGINTEG - Integrated Site flag
14 ; 0 - Not Integrated Site
15 ; 1 - Integrated Site, Single Database
16 ; 2 - Integrated Site, Multiple Database
17 ;
18 ; Input
19 ; DFN - IEN to Patient File #2
20 ; DGPMA - 0 node of patient movement file #405
21 ;
22 ; Get before and after wards
23 S VAIP("D")="LAST",VAIP("M")=1
24 D IN5^VADPT
25 ;
26 ; Get ward prior to transfer, if no movement, then get the admission ward
27 S DGWDP=+VAIP(15,4)
28 S:'DGWDP DGWDP=+VAIP(13,4)
29 ;
30 ; Get ward after transfer
31 S DGWDA=+VAIP(5)
32 ;
33 ;Get Division prior to transfer
34 S DGPDIV=+$$GETDIV^DGRUUTL1(DGWDP)
35 ;
36 ;Get Ien of prior Movement
37 S DGPPMDA=$S($G(DGPMP)]"":$O(^DGPM("B",+DGPMP,0)),$G(DGPM0)]"":$O(^DGPM("B",+DGPM0,0)),1:"")
38 ;
39 ;Get Division after transfer
40 S DGCDIV=+$$GETDIV^DGRUUTL1(DGWDA)
41 ;
42 ;Get Integration flag
43 S DGINTEG=$$GET1^DIQ(43,1,391.705,"I")
44 ;
45 ; If Transfer from MDS to MDS ward, send A02 transfer to COTS
46 I $$CHKWARD^DGRUUTL(DGWDP)&($$CHKWARD^DGRUUTL(DGWDA)) D
47 . I DGINTEG=1!(DGINTEG=2),DGPDIV'=DGCDIV D
48 . . ;If Integrated Database and Wards are in different divisions
49 . . ;Need to create an Admit to new Accu-Max Entity/Box
50 . . ;Need to create Discharge for old Accu-Max Entity/Box
51 . . D BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,DGWDP)
52 . . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,DGWDA)
53 . E D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,DGWDA)
54 ;
55 ; If Transfer from MDS to non-MDS ward, send A03 discharge to COTS
56 I $$CHKWARD^DGRUUTL(DGWDP)&('$$CHKWARD^DGRUUTL(DGWDA)) D
57 . D BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,DGWDA)
58 ;
59 ; If Transfer from non-MDS to MDS ward, send A01 admission to COTS
60 I '$$CHKWARD^DGRUUTL(DGWDP)&($$CHKWARD^DGRUUTL(DGWDA)) D
61 . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,DGWDA)
62 ;
63 ; If transfer from non-MDS to non-MDS ward: Do Nothing
64 Q
65 ;
66MV40(DFN) ; Transfer TO ASIH (VAH)
67 N NHCUADMT,NHCUNODE,PSUEDO,PSUNODE
68 ; Variables
69 ; NHCUADMT - admission IEN to NHCU
70 ; NHCUNODE - Movement entry for admission to NHCU
71 ; MEDADMT - Admission to ASIH Medical ward
72 ; MEDNODE - movement entry to medical ward
73 ; PSUEDO - Psuedo transfer IEN
74 ; PSUNODE - Psuedi discharge node
75 ;
76 ; Retrieve transfer movement
77 S TRANSFER=$O(VAFH(2,0))
78 S TRSNODE=VAFH(2,TRANSFER,"A")
79 ;
80 ; Retrieve admission movement from transfer
81 S NHCUADMT=$P(TRSNODE,"^",14)
82 S NHCUNODE=VAFH(1,NHCUADMT,"A")
83 ;
84 ; Retrieve the ward the patient was admitted to prior to psuedo discharge
85 S DGWARD=+$P(NHCUNODE,"^",6)
86 ; If the ward was flagged RAI, send discharge message to COTS.
87 I $$CHKWARD^DGRUUTL(DGWARD) D
88 . D BLDMSG^DGRUADT1(DFN,"A21",TRANSFER,$P(TRSNODE,"^"),DGWARD)
89 . D ADDASIH^DGRUASIH(DFN,+TRSNODE) ;added 11/22/00 p-328
90 Q
91 ;
92MV41(DFN) ; Discharge from ASIH
93 N TRANSFER,TRSNODE,DGWARD
94 ;
95 ; Retrieve transfer
96 S TRANSFER=$O(VAFH(2,0))
97 S TRSNODE=VAFH(2,TRANSFER,"A")
98 ;
99 ; Retrieve ward transferred to from ASIH discharge
100 S DGWARD=$P(TRSNODE,"^",6)
101 ;
102 I $$CHKWARD^DGRUUTL(DGWARD) D
103 . D BLDMSG^DGRUADT1(DFN,"A22",TRANSFER,+TRSNODE,DGWARD)
104 . D ADDRDT^DGRUASIH(DFN,+TRSNODE) ;added 11/22/00 p-328
105 Q
106 ;
107CN40(DFN) ; Cancel TO ASIH admission
108 N NHCUADMT,NHCUNODE,TRANSFER,TRSNODE,DGWARD
109 ;
110 ; Retrieve transfer movement
111 S TRANSFER=$O(VAFH(2,0))
112 S TRSNODE=VAFH(2,TRANSFER,"P")
113 ;
114 ; Retrieve admission movement from transfer
115 S NHCUADMT=$P(TRSNODE,"^",14)
116 S NHCUNODE=$G(VAFH(1,NHCUADMT,"P"))
117 ;
118 ; Retrieve ward patient admitted to prior to psuedo discharge
119 S DGWARD=$S(NHCUNODE]"":+$P(NHCUNODE,"^",6),1:$P(DGPMP,"^",6))
120 D BLDMSG^DGRUADT1(DFN,"A12",TRANSFER,$P(TRSNODE,"^"),DGWARD)
121 D DELASIH^DGRUASIH(DFN,+TRSNODE) ;added 11/22/00 p-328
122 Q
123 ;
124MV1238(DFN) ;Discharge type Death, if patient was ASIH, send A03 to COTS
125 Q:'$D(DGPMAN)
126 N DGOMDT,DGOWARD,DGOIEN
127 S DGOMDT=+$G(DGPMAN) Q:DGOMDT'>0
128 S DGOMDT=$O(^DGPM("APRD",DFN,DGOMDT),-1) Q:DGOMDT'>0
129 S DGOIEN=$O(^DGPM("APRD",DFN,DGOMDT,0))
130 S DGOWARD=$$GET1^DIQ(405,DGOIEN,".06","I") Q:DGOWARD=""
131 Q:'$$CHKWARD^DGRUUTL(DGOWARD)
132 S DGASIH=1
133 D BLDMSG^DGRUADT1(DFN,"A03",DGOIEN,+DGPMA,DGOWARD)
134 D ADDRDT^DGRUASIH(DFN,+DGPMA) ;added 11/22/00 p-328
135 Q
136 ;
Note: See TracBrowser for help on using the repository browser.