DGRUADT0 ;ALB/GRR - INTEGRATED SITE PROCESSING FOR RAI/MDS ADT MESSAGING; 7-8-99
;;5.3;Registration;**190,312,328**;Aug 13, 1993
;
MV4(DFN,DGPMA) ;
N VAIP,DGWDP,DGWDA,DGPDIV,DGCDIV,DGINTEG
;
; Variables
; VAIP - Patient Data array from lookup utility
; DGWDP - Ward prior to the transfer
; DGWDA - Ward after the transfer
; DGPDIV - Division of Ward prior to transfer
; DGCDIV - Division of Ward after transfer
; DGINTEG - Integrated Site flag
; 0 - Not Integrated Site
; 1 - Integrated Site, Single Database
; 2 - Integrated Site, Multiple Database
;
; Input
; DFN - IEN to Patient File #2
; DGPMA - 0 node of patient movement file #405
;
; Get before and after wards
S VAIP("D")="LAST",VAIP("M")=1
D IN5^VADPT
;
; Get ward prior to transfer, if no movement, then get the admission ward
S DGWDP=+VAIP(15,4)
S:'DGWDP DGWDP=+VAIP(13,4)
;
; Get ward after transfer
S DGWDA=+VAIP(5)
;
;Get Division prior to transfer
S DGPDIV=+$$GETDIV^DGRUUTL1(DGWDP)
;
;Get Ien of prior Movement
S DGPPMDA=$S($G(DGPMP)]"":$O(^DGPM("B",+DGPMP,0)),$G(DGPM0)]"":$O(^DGPM("B",+DGPM0,0)),1:"")
;
;Get Division after transfer
S DGCDIV=+$$GETDIV^DGRUUTL1(DGWDA)
;
;Get Integration flag
S DGINTEG=$$GET1^DIQ(43,1,391.705,"I")
;
; If Transfer from MDS to MDS ward, send A02 transfer to COTS
I $$CHKWARD^DGRUUTL(DGWDP)&($$CHKWARD^DGRUUTL(DGWDA)) D
. I DGINTEG=1!(DGINTEG=2),DGPDIV'=DGCDIV D
. . ;If Integrated Database and Wards are in different divisions
. . ;Need to create an Admit to new Accu-Max Entity/Box
. . ;Need to create Discharge for old Accu-Max Entity/Box
. . D BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,DGWDP)
. . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,DGWDA)
. E D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,DGWDA)
;
; If Transfer from MDS to non-MDS ward, send A03 discharge to COTS
I $$CHKWARD^DGRUUTL(DGWDP)&('$$CHKWARD^DGRUUTL(DGWDA)) D
. D BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,DGWDA)
;
; If Transfer from non-MDS to MDS ward, send A01 admission to COTS
I '$$CHKWARD^DGRUUTL(DGWDP)&($$CHKWARD^DGRUUTL(DGWDA)) D
. D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,DGWDA)
;
; If transfer from non-MDS to non-MDS ward: Do Nothing
Q
;
MV40(DFN) ; Transfer TO ASIH (VAH)
N NHCUADMT,NHCUNODE,PSUEDO,PSUNODE
; Variables
; NHCUADMT - admission IEN to NHCU
; NHCUNODE - Movement entry for admission to NHCU
; MEDADMT - Admission to ASIH Medical ward
; MEDNODE - movement entry to medical ward
; PSUEDO - Psuedo transfer IEN
; PSUNODE - Psuedi discharge node
;
; Retrieve transfer movement
S TRANSFER=$O(VAFH(2,0))
S TRSNODE=VAFH(2,TRANSFER,"A")
;
; Retrieve admission movement from transfer
S NHCUADMT=$P(TRSNODE,"^",14)
S NHCUNODE=VAFH(1,NHCUADMT,"A")
;
; Retrieve the ward the patient was admitted to prior to psuedo discharge
S DGWARD=+$P(NHCUNODE,"^",6)
; If the ward was flagged RAI, send discharge message to COTS.
I $$CHKWARD^DGRUUTL(DGWARD) D
. D BLDMSG^DGRUADT1(DFN,"A21",TRANSFER,$P(TRSNODE,"^"),DGWARD)
. D ADDASIH^DGRUASIH(DFN,+TRSNODE) ;added 11/22/00 p-328
Q
;
MV41(DFN) ; Discharge from ASIH
N TRANSFER,TRSNODE,DGWARD
;
; Retrieve transfer
S TRANSFER=$O(VAFH(2,0))
S TRSNODE=VAFH(2,TRANSFER,"A")
;
; Retrieve ward transferred to from ASIH discharge
S DGWARD=$P(TRSNODE,"^",6)
;
I $$CHKWARD^DGRUUTL(DGWARD) D
. D BLDMSG^DGRUADT1(DFN,"A22",TRANSFER,+TRSNODE,DGWARD)
. D ADDRDT^DGRUASIH(DFN,+TRSNODE) ;added 11/22/00 p-328
Q
;
CN40(DFN) ; Cancel TO ASIH admission
N NHCUADMT,NHCUNODE,TRANSFER,TRSNODE,DGWARD
;
; Retrieve transfer movement
S TRANSFER=$O(VAFH(2,0))
S TRSNODE=VAFH(2,TRANSFER,"P")
;
; Retrieve admission movement from transfer
S NHCUADMT=$P(TRSNODE,"^",14)
S NHCUNODE=$G(VAFH(1,NHCUADMT,"P"))
;
; Retrieve ward patient admitted to prior to psuedo discharge
S DGWARD=$S(NHCUNODE]"":+$P(NHCUNODE,"^",6),1:$P(DGPMP,"^",6))
D BLDMSG^DGRUADT1(DFN,"A12",TRANSFER,$P(TRSNODE,"^"),DGWARD)
D DELASIH^DGRUASIH(DFN,+TRSNODE) ;added 11/22/00 p-328
Q
;
MV1238(DFN) ;Discharge type Death, if patient was ASIH, send A03 to COTS
Q:'$D(DGPMAN)
N DGOMDT,DGOWARD,DGOIEN
S DGOMDT=+$G(DGPMAN) Q:DGOMDT'>0
S DGOMDT=$O(^DGPM("APRD",DFN,DGOMDT),-1) Q:DGOMDT'>0
S DGOIEN=$O(^DGPM("APRD",DFN,DGOMDT,0))
S DGOWARD=$$GET1^DIQ(405,DGOIEN,".06","I") Q:DGOWARD=""
Q:'$$CHKWARD^DGRUUTL(DGOWARD)
S DGASIH=1
D BLDMSG^DGRUADT1(DFN,"A03",DGOIEN,+DGPMA,DGOWARD)
D ADDRDT^DGRUASIH(DFN,+DGPMA) ;added 11/22/00 p-328
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUADT0 4631 printed Dec 13, 2024@02:58:01 Page 2
DGRUADT0 ;ALB/GRR - INTEGRATED SITE PROCESSING FOR RAI/MDS ADT MESSAGING; 7-8-99
+1 ;;5.3;Registration;**190,312,328**;Aug 13, 1993
+2 ;
MV4(DFN,DGPMA) ;
+1 NEW VAIP,DGWDP,DGWDA,DGPDIV,DGCDIV,DGINTEG
+2 ;
+3 ; Variables
+4 ; VAIP - Patient Data array from lookup utility
+5 ; DGWDP - Ward prior to the transfer
+6 ; DGWDA - Ward after the transfer
+7 ; DGPDIV - Division of Ward prior to transfer
+8 ; DGCDIV - Division of Ward after transfer
+9 ; DGINTEG - Integrated Site flag
+10 ; 0 - Not Integrated Site
+11 ; 1 - Integrated Site, Single Database
+12 ; 2 - Integrated Site, Multiple Database
+13 ;
+14 ; Input
+15 ; DFN - IEN to Patient File #2
+16 ; DGPMA - 0 node of patient movement file #405
+17 ;
+18 ; Get before and after wards
+19 SET VAIP("D")="LAST"
SET VAIP("M")=1
+20 DO IN5^VADPT
+21 ;
+22 ; Get ward prior to transfer, if no movement, then get the admission ward
+23 SET DGWDP=+VAIP(15,4)
+24 if 'DGWDP
SET DGWDP=+VAIP(13,4)
+25 ;
+26 ; Get ward after transfer
+27 SET DGWDA=+VAIP(5)
+28 ;
+29 ;Get Division prior to transfer
+30 SET DGPDIV=+$$GETDIV^DGRUUTL1(DGWDP)
+31 ;
+32 ;Get Ien of prior Movement
+33 SET DGPPMDA=$SELECT($GET(DGPMP)]"":$ORDER(^DGPM("B",+DGPMP,0)),$GET(DGPM0)]"":$ORDER(^DGPM("B",+DGPM0,0)),1:"")
+34 ;
+35 ;Get Division after transfer
+36 SET DGCDIV=+$$GETDIV^DGRUUTL1(DGWDA)
+37 ;
+38 ;Get Integration flag
+39 SET DGINTEG=$$GET1^DIQ(43,1,391.705,"I")
+40 ;
+41 ; If Transfer from MDS to MDS ward, send A02 transfer to COTS
+42 IF $$CHKWARD^DGRUUTL(DGWDP)&($$CHKWARD^DGRUUTL(DGWDA))
Begin DoDot:1
+43 IF DGINTEG=1!(DGINTEG=2)
IF DGPDIV'=DGCDIV
Begin DoDot:2
+44 ;If Integrated Database and Wards are in different divisions
+45 ;Need to create an Admit to new Accu-Max Entity/Box
+46 ;Need to create Discharge for old Accu-Max Entity/Box
+47 DO BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,DGWDP)
+48 DO BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,DGWDA)
End DoDot:2
+49 IF '$TEST
DO BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,DGWDA)
End DoDot:1
+50 ;
+51 ; If Transfer from MDS to non-MDS ward, send A03 discharge to COTS
+52 IF $$CHKWARD^DGRUUTL(DGWDP)&('$$CHKWARD^DGRUUTL(DGWDA))
Begin DoDot:1
+53 DO BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,DGWDA)
End DoDot:1
+54 ;
+55 ; If Transfer from non-MDS to MDS ward, send A01 admission to COTS
+56 IF '$$CHKWARD^DGRUUTL(DGWDP)&($$CHKWARD^DGRUUTL(DGWDA))
Begin DoDot:1
+57 DO BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,DGWDA)
End DoDot:1
+58 ;
+59 ; If transfer from non-MDS to non-MDS ward: Do Nothing
+60 QUIT
+61 ;
MV40(DFN) ; Transfer TO ASIH (VAH)
+1 NEW NHCUADMT,NHCUNODE,PSUEDO,PSUNODE
+2 ; Variables
+3 ; NHCUADMT - admission IEN to NHCU
+4 ; NHCUNODE - Movement entry for admission to NHCU
+5 ; MEDADMT - Admission to ASIH Medical ward
+6 ; MEDNODE - movement entry to medical ward
+7 ; PSUEDO - Psuedo transfer IEN
+8 ; PSUNODE - Psuedi discharge node
+9 ;
+10 ; Retrieve transfer movement
+11 SET TRANSFER=$ORDER(VAFH(2,0))
+12 SET TRSNODE=VAFH(2,TRANSFER,"A")
+13 ;
+14 ; Retrieve admission movement from transfer
+15 SET NHCUADMT=$PIECE(TRSNODE,"^",14)
+16 SET NHCUNODE=VAFH(1,NHCUADMT,"A")
+17 ;
+18 ; Retrieve the ward the patient was admitted to prior to psuedo discharge
+19 SET DGWARD=+$PIECE(NHCUNODE,"^",6)
+20 ; If the ward was flagged RAI, send discharge message to COTS.
+21 IF $$CHKWARD^DGRUUTL(DGWARD)
Begin DoDot:1
+22 DO BLDMSG^DGRUADT1(DFN,"A21",TRANSFER,$PIECE(TRSNODE,"^"),DGWARD)
+23 ;added 11/22/00 p-328
DO ADDASIH^DGRUASIH(DFN,+TRSNODE)
End DoDot:1
+24 QUIT
+25 ;
MV41(DFN) ; Discharge from ASIH
+1 NEW TRANSFER,TRSNODE,DGWARD
+2 ;
+3 ; Retrieve transfer
+4 SET TRANSFER=$ORDER(VAFH(2,0))
+5 SET TRSNODE=VAFH(2,TRANSFER,"A")
+6 ;
+7 ; Retrieve ward transferred to from ASIH discharge
+8 SET DGWARD=$PIECE(TRSNODE,"^",6)
+9 ;
+10 IF $$CHKWARD^DGRUUTL(DGWARD)
Begin DoDot:1
+11 DO BLDMSG^DGRUADT1(DFN,"A22",TRANSFER,+TRSNODE,DGWARD)
+12 ;added 11/22/00 p-328
DO ADDRDT^DGRUASIH(DFN,+TRSNODE)
End DoDot:1
+13 QUIT
+14 ;
CN40(DFN) ; Cancel TO ASIH admission
+1 NEW NHCUADMT,NHCUNODE,TRANSFER,TRSNODE,DGWARD
+2 ;
+3 ; Retrieve transfer movement
+4 SET TRANSFER=$ORDER(VAFH(2,0))
+5 SET TRSNODE=VAFH(2,TRANSFER,"P")
+6 ;
+7 ; Retrieve admission movement from transfer
+8 SET NHCUADMT=$PIECE(TRSNODE,"^",14)
+9 SET NHCUNODE=$GET(VAFH(1,NHCUADMT,"P"))
+10 ;
+11 ; Retrieve ward patient admitted to prior to psuedo discharge
+12 SET DGWARD=$SELECT(NHCUNODE]"":+$PIECE(NHCUNODE,"^",6),1:$PIECE(DGPMP,"^",6))
+13 DO BLDMSG^DGRUADT1(DFN,"A12",TRANSFER,$PIECE(TRSNODE,"^"),DGWARD)
+14 ;added 11/22/00 p-328
DO DELASIH^DGRUASIH(DFN,+TRSNODE)
+15 QUIT
+16 ;
MV1238(DFN) ;Discharge type Death, if patient was ASIH, send A03 to COTS
+1 if '$DATA(DGPMAN)
QUIT
+2 NEW DGOMDT,DGOWARD,DGOIEN
+3 SET DGOMDT=+$GET(DGPMAN)
if DGOMDT'>0
QUIT
+4 SET DGOMDT=$ORDER(^DGPM("APRD",DFN,DGOMDT),-1)
if DGOMDT'>0
QUIT
+5 SET DGOIEN=$ORDER(^DGPM("APRD",DFN,DGOMDT,0))
+6 SET DGOWARD=$$GET1^DIQ(405,DGOIEN,".06","I")
if DGOWARD=""
QUIT
+7 if '$$CHKWARD^DGRUUTL(DGOWARD)
QUIT
+8 SET DGASIH=1
+9 DO BLDMSG^DGRUADT1(DFN,"A03",DGOIEN,+DGPMA,DGOWARD)
+10 ;added 11/22/00 p-328
DO ADDRDT^DGRUASIH(DFN,+DGPMA)
+11 QUIT
+12 ;
