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

DGRUADT.m

Go to the documentation of this file.
  1. DGRUADT ;ALB/SCK - MAIN DRIVER FOR RAI/MDS ADT MESSAGING; 7-8-99 ; 29 Aug 2006 9:07 AM
  1. ;;5.3;Registration;**190,312,328,373,430,464,721**;Aug 13, 1993;Build 3
  1. ;
  1. EN ; Main entry point for generating an HL7 ADT message to the COTS system
  1. ; The message builder is tasked off to taskManager to build and transmit
  1. ; the ADT message to the vendor.
  1. ; Input:
  1. ; DGPMP - 0 node of the primary movement BEFORE the ADT action
  1. ; DGPMA - 0 node of the primary movement AFTER the ADT action
  1. ; DFN - Ien of the patient in the PATIENT File (#2)
  1. ; DGPMDA - Ien of the movement
  1. ; DGQUIET - Flag to suppress read/writes if set
  1. ; DGADT - Data array for processing ADT events
  1. ; DGTRACE - Debugging parameter
  1. ; DGPDIV - Division for prior Ward
  1. ; DGCDIV - Division for current Ward
  1. ; DGINTEG - Integration Database flag
  1. ; 0 - Not Integrated Site
  1. ; 1 - Integrated, Single Database
  1. ; 2 - Integrated, Multiple Databases
  1. ; DGPMVI - Array where results from call to IN5^VADPT returned
  1. ;
  1. N DGTRACE,VAFH
  1. ;
  1. ; Test for ADT on/off parameter
  1. Q:'$P($$SEND^VAFHUTL(),"^",2)
  1. ;
  1. M VAFH=^UTILITY("DGPM",$J)
  1. ;
  1. I '($G(DGQUIET)) D
  1. . W !,"Executing HL7 ADT Messaging (RAI/MDS)"
  1. . I $D(^TMP("DGRUADT1")) S DGTRACE=1
  1. I $D(DGTRACE) D G EXIT
  1. . D INIT
  1. ;
  1. N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH,X,ZTQUEUED,ZTREQ
  1. S ZTDESC="HL7 ADT MESSAGE (RAI/MDS)",ZTRTN="EVENT^DGRUADT"
  1. F X="DGPMP","DGPMA","DGPMDA","DFN","DGPMAN","VAFH(" S ZTSAVE(X)=""
  1. S ZTIO="",ZTDTH=$H
  1. D ^%ZTLOAD
  1. EXIT ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. D KILL^HLTRANS
  1. K ^TMP("HLS",$J)
  1. Q
  1. ;
  1. INIT ;
  1. D EVENT,EXIT
  1. Q
  1. ;
  1. EVENT ;
  1. N DGTYPE,DGMOVE,DGADMSN,VAFHDT,DGEVENT,VAIP
  1. ;
  1. ; Check for valid movements
  1. I $G(DGPMP)=""&($G(DGPMA)="") Q
  1. ;
  1. ; Determine the event transaction type. The events are:
  1. ;
  1. ; If DGPMP is null and DGPMA is not, then adding a new ADT event
  1. I (DGPMP="")&(DGPMA'="") D G EVENTQ
  1. . D SETVAR(DGPMA)
  1. . ;
  1. . ; If DGTYPE=6, then this a treating specialty change, check if this is for
  1. . ; a provider change.
  1. . I (DGTYPE=6) D Q
  1. . . N VAIN,VAINDT
  1. . . S VAINDT=+DGPMA
  1. . . D INP^VADPT
  1. . . ; I (+VAIN(2)=+$G(DGPMVI(7)))&(+VAIN(11)=+$G(DGPMVI(18))) Q p-721
  1. . . Q:'$$CHKWARD^DGRUUTL(+$G(DGPMVI(5)))
  1. . . W:$D(DGTRACE) !,1.6
  1. . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGPMVI(5))
  1. . ;
  1. . ; If DGTYPE=1, then it means an admission
  1. . I (DGTYPE=1) S DGEVENT="A01" D Q
  1. . . W:$D(DGTRACE) !,1.1
  1. . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
  1. . . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
  1. . ;
  1. . ; If DGTYPE=3, then it means a discharge
  1. . I (DGTYPE=3) S DGEVENT="A03" D Q
  1. . . W:$D(DGTRACE) !,1.3
  1. . . S DGMOVE=$$MOVETYPE(DGPMA)
  1. . . ;
  1. . . ;If Movement type "From ASIH" create A22 and send to COTS
  1. . . I DGMOVE=41!(DGMOVE=14) D MV41^DGRUADT0(DFN) Q
  1. . . ;
  1. . . ; Get ward discharged from, if RAI/MDS, then process message
  1. . . N VAIP S VAIP("D")="LAST"
  1. . . D IN5^VADPT
  1. . . ;If Movement type "Death" must check to see if patient was ASIH
  1. . . ;If patient was ASIH, create and send A03 to COTS
  1. . . I $P($G(DGPMAN),"^",21)]"" N DGASIH D MV1238^DGRUADT0(DFN) Q:$G(DGASIH)=1 ;modified p-373
  1. . . ;
  1. . . Q:'$$CHKWARD^DGRUUTL(+VAIP(17,4))
  1. . . D BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,+VAIP(17,4))
  1. . ;
  1. . ; If DGTYPE=2, then it means a transfer
  1. . I (DGTYPE=2) S DGEVENT="A02" D Q
  1. . . W:$D(DGTRACE) !,1.2
  1. . . S DGMOVE=$$MOVETYPE(DGPMA)
  1. . . ;
  1. . . ; If transfer to ASIH
  1. . . I DGMOVE=13!(DGMOVE=43)!(DGMOVE=40) D MV40^DGRUADT0(DFN) Q
  1. . . ;
  1. . . ;If transfer From ASIH
  1. . . I DGMOVE=14!(DGMOVE=41) D MV41^DGRUADT0(DFN) Q
  1. . . ; If transfer is to Leave of absence
  1. . . I DGMOVE=1!(DGMOVE=2)!(DGMOVE=3) D Q ;modified p-328
  1. . . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
  1. . . . D BLDMSG^DGRUADT1(DFN,"A21",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
  1. . . ;
  1. . . ; If transfer is from Leave of absence
  1. . . I DGMOVE=23!(DGMOVE=24)!(DGMOVE=22) D Q
  1. . . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
  1. . . . D BLDMSG^DGRUADT1(DFN,"A22",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
  1. . . ;
  1. . . I DGMOVE=4 D MV4^DGRUADT0(DFN,DGPMA)
  1. . ;
  1. ;
  1. ; If DGPMP and DGPMA are both NOT null, then editing an ADT event
  1. I (DGPMP'="")&(DGPMA'="") D EDITADT^DGRUADT2 G EVENTQ
  1. ;
  1. ; If DGPMP is not null and DGPMA is, then deleting an ADT event
  1. I (DGPMP'="")&(DGPMA="") D G EVENTQ
  1. . D SETVAR(DGPMP)
  1. . S DGMOVE=$$MOVETYPE(DGPMP)
  1. . ;
  1. . ; If DGTYPE=1, then deleting an admission
  1. . I (DGTYPE=1) S DGEVENT="A11" D Q
  1. . . W:$D(DGTRACE) !,3.1
  1. . . ;Check if deleting an admission for an ASIH event
  1. . . I DGMOVE=13!(DGMOVE=43)!(DGMOVE=40) D CN40^DGRUADT0(DFN) Q
  1. . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMP,"^",6)) ;Quit if not RAI/MDS ward
  1. . . ;
  1. . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
  1. . ;
  1. . ; If DGTYPE=3, then deleting a discharge
  1. . I (DGTYPE=3) S DGEVENT="A13" D Q
  1. . . W:$D(DGTRACE) !,3.3
  1. . . S VAIP("D")="LAST",VAIP("M")=1
  1. . . D IN5^VADPT
  1. . . ; Get ward. Use last movement if it exists, if not use the current movement.
  1. . . N DGWARD S DGWARD=(+VAIP(14,4))
  1. . . I $P($G(DGPMAN),"^",21)]"" N DGASIH D Q:$G(DGASIH)=3 ;Deleting discharge which relates to ASIH (312), modified p-373
  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 ;Get movement prior to ASIH
  1. . . . S DGOIEN=$O(^DGPM("APRD",DFN,DGOMDT,0)) ;Get IEN of movement
  1. . . . S DGOWARD=$$GET1^DIQ(405,DGOIEN,".06","I") Q:DGOWARD=""
  1. . . . Q:'$$CHKWARD^DGRUUTL(DGOWARD) ;Quit if not RAI/MDS flag
  1. . . . N DGLDDAT S DGLDDAT=$O(^DGPM("APTT3",DFN,""),-1) ;p-430
  1. . . . I $G(DGLDDAT)]"",DGLDDAT>+$P($G(DGPMAN),"^"),DGLDDAT<+$G(DGNOW) Q ;p-430
  1. . . . K DGLDDAT ;p-430
  1. . . . S DGASIH=3 ;Set flag to identify ASIH (used by DGRUGA13)
  1. . . . D BLDMSG^DGRUADT1(DFN,"A13",DGOIEN,+DGPMP,DGOWARD)
  1. . . . N DGSTAT,DGIEN S DGSTAT="A" ;p-430
  1. . . . S DGIEN=$O(^DGRU(46.14,DFN,1,"B",+$G(DGPMAN),0)) Q:DGIEN="" ;p-430
  1. . . . D UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT) ;p-430
  1. . . S:'DGWARD DGWARD=+VAIP(5)
  1. . . Q:'$$CHKWARD^DGRUUTL(DGWARD)
  1. . . D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARD)
  1. . ;
  1. . ; If DGTYPE=2, then deleting a transfer
  1. . I (DGTYPE=2) S DGEVENT="A12" D Q
  1. . . W:$D(DGTRACE) !,3.2
  1. . . N DGWARDP,DGWARDA,VAIP
  1. . . S DGWARDP=+$P(DGPMP,"^",6)
  1. . . N VAIP S VAIP("D")="LAST",VAIP("M")=1
  1. . . D IN5^VADPT
  1. . . S DGWARDA=+VAIP(5)
  1. . . I 'DGWARDP!('DGWARDA) D Q
  1. . . . W !,"Unable to determine wards for transfer cancellation"
  1. . . ;
  1. . . ;Get Division for prior Ward
  1. . . S DGPDIV=+$$GETDIV^DGRUUTL1(DGWARDP)
  1. . . ;
  1. . . ;Get Division for current Ward
  1. . . S DGCDIV=+$$GETDIV^DGRUUTL1(DGWARDA)
  1. . . ;
  1. . . ;Get Integration flag
  1. . . S DGINTEG=+$$GET1^DIQ(43,1,391.705,"I")
  1. . . ;
  1. . . ; If cancel transfer mds to mds ward: A12
  1. . . I $$CHKWARD^DGRUUTL(DGWARDP)&($$CHKWARD^DGRUUTL(DGWARDA)) D Q
  1. . . . I DGINTEG=1!(DGINTEG=2),DGPDIV'=DGCDIV D
  1. . . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,DGWARDP)
  1. . . . . D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARDA)
  1. . . . E D ;
  1. . . . . D BLDMSG^DGRUADT1(DFN,"A12",DGPMDA,+DGPMP,DGWARDP)
  1. . . . . I DGMOVE=43 D DELASIH^DGRUASIH(DFN,VAFHDT) ;p-464
  1. . . ; If cancel transfer to non-mds ward from an mds ward: A13
  1. . . I '$$CHKWARD^DGRUUTL(DGWARDP)&($$CHKWARD^DGRUUTL(DGWARDA)) D Q
  1. . . . D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARDP)
  1. . . ; If cancel transfer to mds ward from an non-mds ward: A11
  1. . . I $$CHKWARD^DGRUUTL(DGWARDP)&('$$CHKWARD^DGRUUTL(DGWARDA)) D Q
  1. . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,DGWARDP)
  1. ;
  1. EVENTQ Q
  1. ;
  1. SETVAR(NODE) ;
  1. S DGTYPE=$P(NODE,"^",2),VAFHDT=$P(NODE,"^",1),DGADMSN=$P(NODE,"^",14)
  1. Q
  1. ;
  1. MOVETYPE(NODE) ;
  1. N TYPE
  1. S TYPE=$P(NODE,"^",18)
  1. Q +$G(TYPE)