Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGRUADT0

DGRUADT0.m

Go to the documentation of this file. 
  1. DGRUADT0 ;ALB/GRR - INTEGRATED SITE PROCESSING FOR RAI/MDS ADT MESSAGING; 7-8-99
  1.  ;;5.3;Registration;**190,312,328,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. MV4(DFN,DGPMA) ;
  1.  N VAIP,DGWDP,DGWDA,DGPDIV,DGCDIV,DGINTEG
  1.  ;
  1.  ; Variables
  1.  ;   VAIP  - Patient Data array from lookup utility
  1.  ;   DGWDP - Ward prior to the transfer
  1.  ;   DGWDA - Ward after the transfer
  1.  ;   DGPDIV - Division of Ward prior to transfer
  1.  ;   DGCDIV - Division of Ward after transfer
  1.  ;   DGINTEG - Integrated Site flag
  1.  ;             0 - Not Integrated Site
  1.  ;             1 - Integrated Site, Single Database
  1.  ;             2 - Integrated Site, Multiple Database
  1.  ;  
  1.  ; Input
  1.  ;   DFN   - IEN to Patient File #2
  1.  ;   DGPMA - 0 node of patient movement file #405
  1.  ; 
  1.  ; Get before and after wards
  1.  S VAIP("D")="LAST",VAIP("M")=1
  1.  D IN5^VADPT
  1.  ;
  1.  ; Get ward prior to transfer, if no movement, then get the admission ward
  1.  S DGWDP=+VAIP(15,4)
  1.  S:'DGWDP DGWDP=+VAIP(13,4)
  1.  ;
  1.  ; Get ward after transfer
  1.  S DGWDA=+VAIP(5)
  1.  ;
  1.  ;Get Division prior to transfer
  1.  S DGPDIV=+$$GETDIV^DGRUUTL1(DGWDP)
  1.  ;
  1.  ;Get Ien of prior Movement
  1.  S DGPPMDA=$S($G(DGPMP)]"":$O(^DGPM("B",+DGPMP,0)),$G(DGPM0)]"":$O(^DGPM("B",+DGPM0,0)),1:"")
  1.  ;
  1.  ;Get Division after transfer
  1.  S DGCDIV=+$$GETDIV^DGRUUTL1(DGWDA)
  1.  ;
  1.  ;Get Integration flag
  1.  S DGINTEG=$$GET1^DIQ(43,1,391.705,"I")
  1.  ;
  1.  ; If Transfer from MDS to MDS ward, send A02 transfer to COTS
  1.  I $$CHKWARD^DGRUUTL(DGWDP)&($$CHKWARD^DGRUUTL(DGWDA)) D
  1.  . I DGINTEG=1!(DGINTEG=2),DGPDIV'=DGCDIV D
  1.  . . ;If Integrated Database and Wards are in different divisions
  1.  . . ;Need to create an Admit to new Accu-Max Entity/Box
  1.  . . ;Need to create Discharge for old Accu-Max Entity/Box
  1.  . . D BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,DGWDP)
  1.  . . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,DGWDA)
  1.  . E  D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,DGWDA)
  1.  ;
  1.  ; If Transfer from MDS to non-MDS ward, send A03 discharge to COTS
  1.  I $$CHKWARD^DGRUUTL(DGWDP)&('$$CHKWARD^DGRUUTL(DGWDA)) D
  1.  . D BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,DGWDA)
  1.  ;
  1.  ; If Transfer from non-MDS to MDS ward, send A01 admission to COTS
  1.  I '$$CHKWARD^DGRUUTL(DGWDP)&($$CHKWARD^DGRUUTL(DGWDA)) D
  1.  . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,DGWDA)
  1.  ;
  1.  ; If transfer from non-MDS to non-MDS ward: Do Nothing
  1.  Q
  1.  ;
  1. MV40(DFN) ; Transfer TO ASIH (VAH)
  1.  N NHCUADMT,NHCUNODE,PSUEDO,PSUNODE
  1.  ; Variables
  1.  ;    NHCUADMT - admission IEN to NHCU
  1.  ;    NHCUNODE - Movement entry for admission to NHCU
  1.  ;    MEDADMT  - Admission to ASIH Medical ward
  1.  ;    MEDNODE  - movement entry to medical ward
  1.  ;    PSUEDO   - Psuedo transfer IEN
  1.  ;    PSUNODE  - Psuedi discharge node
  1.  ;
  1.  ; Retrieve transfer movement
  1.  S TRANSFER=$O(VAFH(2,0))
  1.  S TRSNODE=VAFH(2,TRANSFER,"A")
  1.  ;
  1.  ; Retrieve admission movement from transfer
  1.  S NHCUADMT=$P(TRSNODE,"^",14)
  1.  S NHCUNODE=VAFH(1,NHCUADMT,"A")
  1.  ;
  1.  ; Retrieve the ward the patient was admitted to prior to psuedo discharge
  1.  S DGWARD=+$P(NHCUNODE,"^",6)
  1.  ; If the ward was flagged RAI, send discharge message to COTS.
  1.  I $$CHKWARD^DGRUUTL(DGWARD) D
  1.  . D BLDMSG^DGRUADT1(DFN,"A21",TRANSFER,$P(TRSNODE,"^"),DGWARD)
  1.  . D ADDASIH^DGRUASIH(DFN,+TRSNODE) ;added 11/22/00 p-328
  1.  Q
  1.  ;
  1. MV41(DFN) ; Discharge from ASIH
  1.  N TRANSFER,TRSNODE,DGWARD
  1.  ;
  1.  ; Retrieve transfer
  1.  S TRANSFER=$O(VAFH(2,0))
  1.  S TRSNODE=VAFH(2,TRANSFER,"A")
  1.  ;
  1.  ; Retrieve ward transferred to from ASIH discharge
  1.  S DGWARD=$P(TRSNODE,"^",6)
  1.  ;
  1.  I $$CHKWARD^DGRUUTL(DGWARD) D
  1.  . D BLDMSG^DGRUADT1(DFN,"A22",TRANSFER,+TRSNODE,DGWARD)
  1.  . D ADDRDT^DGRUASIH(DFN,+TRSNODE) ;added 11/22/00 p-328
  1.  Q
  1.  ;
  1. CN40(DFN) ; Cancel TO ASIH admission
  1.  N NHCUADMT,NHCUNODE,TRANSFER,TRSNODE,DGWARD
  1.  ;
  1.  ; Retrieve transfer movement
  1.  S TRANSFER=$O(VAFH(2,0))
  1.  S TRSNODE=VAFH(2,TRANSFER,"P")
  1.  ;
  1.  ; Retrieve admission movement from transfer
  1.  S NHCUADMT=$P(TRSNODE,"^",14)
  1.  S NHCUNODE=$G(VAFH(1,NHCUADMT,"P"))
  1.  ;
  1.  ; Retrieve ward patient admitted to prior to psuedo discharge
  1.  S DGWARD=$S(NHCUNODE]"":+$P(NHCUNODE,"^",6),1:$P(DGPMP,"^",6))
  1.  D BLDMSG^DGRUADT1(DFN,"A12",TRANSFER,$P(TRSNODE,"^"),DGWARD)
  1.  D DELASIH^DGRUASIH(DFN,+TRSNODE) ;added 11/22/00 p-328
  1.  Q
  1.  ;
  1. MV1238(DFN) ;Discharge type Death, if patient was ASIH, send A03 to COTS
  1.  Q:'$D(DGPMAN)
  1.  N DGOMDT,DGOWARD,DGOIEN
  1.  S DGOMDT=+$G(DGPMAN) Q:DGOMDT'>0
  1.  S DGOMDT=$O(^DGPM("APRD",DFN,DGOMDT),-1) Q:DGOMDT'>0
  1.  S DGOIEN=$O(^DGPM("APRD",DFN,DGOMDT,0))
  1.  S DGOWARD=$$GET1^DIQ(405,DGOIEN,".06","I") Q:DGOWARD=""
  1.  Q:'$$CHKWARD^DGRUUTL(DGOWARD)
  1.  S DGASIH=1
  1.  D BLDMSG^DGRUADT1(DFN,"A03",DGOIEN,+DGPMA,DGOWARD)
  1.  D ADDRDT^DGRUASIH(DFN,+DGPMA) ;added 11/22/00 p-328
  1.  Q
  1.  ;