DGRUADT ;ALB/SCK - MAIN DRIVER FOR RAI/MDS ADT MESSAGING; 7-8-99 ; 29 Aug 2006 9:07 AM
;;5.3;Registration;**190,312,328,373,430,464,721**;Aug 13, 1993;Build 3
;
EN ; Main entry point for generating an HL7 ADT message to the COTS system
; The message builder is tasked off to taskManager to build and transmit
; the ADT message to the vendor.
; Input:
; DGPMP - 0 node of the primary movement BEFORE the ADT action
; DGPMA - 0 node of the primary movement AFTER the ADT action
; DFN - Ien of the patient in the PATIENT File (#2)
; DGPMDA - Ien of the movement
; DGQUIET - Flag to suppress read/writes if set
; DGADT - Data array for processing ADT events
; DGTRACE - Debugging parameter
; DGPDIV - Division for prior Ward
; DGCDIV - Division for current Ward
; DGINTEG - Integration Database flag
; 0 - Not Integrated Site
; 1 - Integrated, Single Database
; 2 - Integrated, Multiple Databases
; DGPMVI - Array where results from call to IN5^VADPT returned
;
N DGTRACE,VAFH
;
; Test for ADT on/off parameter
Q:'$P($$SEND^VAFHUTL(),"^",2)
;
M VAFH=^UTILITY("DGPM",$J)
;
I '($G(DGQUIET)) D
. W !,"Executing HL7 ADT Messaging (RAI/MDS)"
. I $D(^TMP("DGRUADT1")) S DGTRACE=1
I $D(DGTRACE) D G EXIT
. D INIT
;
N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH,X,ZTQUEUED,ZTREQ
S ZTDESC="HL7 ADT MESSAGE (RAI/MDS)",ZTRTN="EVENT^DGRUADT"
F X="DGPMP","DGPMA","DGPMDA","DFN","DGPMAN","VAFH(" S ZTSAVE(X)=""
S ZTIO="",ZTDTH=$H
D ^%ZTLOAD
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
D KILL^HLTRANS
K ^TMP("HLS",$J)
Q
;
INIT ;
D EVENT,EXIT
Q
;
EVENT ;
N DGTYPE,DGMOVE,DGADMSN,VAFHDT,DGEVENT,VAIP
;
; Check for valid movements
I $G(DGPMP)=""&($G(DGPMA)="") Q
;
; Determine the event transaction type. The events are:
;
; If DGPMP is null and DGPMA is not, then adding a new ADT event
I (DGPMP="")&(DGPMA'="") D G EVENTQ
. D SETVAR(DGPMA)
. ;
. ; If DGTYPE=6, then this a treating specialty change, check if this is for
. ; a provider change.
. I (DGTYPE=6) D Q
. . N VAIN,VAINDT
. . S VAINDT=+DGPMA
. . D INP^VADPT
. . ; I (+VAIN(2)=+$G(DGPMVI(7)))&(+VAIN(11)=+$G(DGPMVI(18))) Q p-721
. . Q:'$$CHKWARD^DGRUUTL(+$G(DGPMVI(5)))
. . W:$D(DGTRACE) !,1.6
. . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGPMVI(5))
. ;
. ; If DGTYPE=1, then it means an admission
. I (DGTYPE=1) S DGEVENT="A01" D Q
. . W:$D(DGTRACE) !,1.1
. . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
. . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
. ;
. ; If DGTYPE=3, then it means a discharge
. I (DGTYPE=3) S DGEVENT="A03" D Q
. . W:$D(DGTRACE) !,1.3
. . S DGMOVE=$$MOVETYPE(DGPMA)
. . ;
. . ;If Movement type "From ASIH" create A22 and send to COTS
. . I DGMOVE=41!(DGMOVE=14) D MV41^DGRUADT0(DFN) Q
. . ;
. . ; Get ward discharged from, if RAI/MDS, then process message
. . N VAIP S VAIP("D")="LAST"
. . D IN5^VADPT
. . ;If Movement type "Death" must check to see if patient was ASIH
. . ;If patient was ASIH, create and send A03 to COTS
. . I $P($G(DGPMAN),"^",21)]"" N DGASIH D MV1238^DGRUADT0(DFN) Q:$G(DGASIH)=1 ;modified p-373
. . ;
. . Q:'$$CHKWARD^DGRUUTL(+VAIP(17,4))
. . D BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,+VAIP(17,4))
. ;
. ; If DGTYPE=2, then it means a transfer
. I (DGTYPE=2) S DGEVENT="A02" D Q
. . W:$D(DGTRACE) !,1.2
. . S DGMOVE=$$MOVETYPE(DGPMA)
. . ;
. . ; If transfer to ASIH
. . I DGMOVE=13!(DGMOVE=43)!(DGMOVE=40) D MV40^DGRUADT0(DFN) Q
. . ;
. . ;If transfer From ASIH
. . I DGMOVE=14!(DGMOVE=41) D MV41^DGRUADT0(DFN) Q
. . ; If transfer is to Leave of absence
. . I DGMOVE=1!(DGMOVE=2)!(DGMOVE=3) D Q ;modified p-328
. . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
. . . D BLDMSG^DGRUADT1(DFN,"A21",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
. . ;
. . ; If transfer is from Leave of absence
. . I DGMOVE=23!(DGMOVE=24)!(DGMOVE=22) D Q
. . . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
. . . D BLDMSG^DGRUADT1(DFN,"A22",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
. . ;
. . I DGMOVE=4 D MV4^DGRUADT0(DFN,DGPMA)
. ;
;
; If DGPMP and DGPMA are both NOT null, then editing an ADT event
I (DGPMP'="")&(DGPMA'="") D EDITADT^DGRUADT2 G EVENTQ
;
; If DGPMP is not null and DGPMA is, then deleting an ADT event
I (DGPMP'="")&(DGPMA="") D G EVENTQ
. D SETVAR(DGPMP)
. S DGMOVE=$$MOVETYPE(DGPMP)
. ;
. ; If DGTYPE=1, then deleting an admission
. I (DGTYPE=1) S DGEVENT="A11" D Q
. . W:$D(DGTRACE) !,3.1
. . ;Check if deleting an admission for an ASIH event
. . I DGMOVE=13!(DGMOVE=43)!(DGMOVE=40) D CN40^DGRUADT0(DFN) Q
. . Q:'$$CHKWARD^DGRUUTL(+$P(DGPMP,"^",6)) ;Quit if not RAI/MDS ward
. . ;
. . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
. ;
. ; If DGTYPE=3, then deleting a discharge
. I (DGTYPE=3) S DGEVENT="A13" D Q
. . W:$D(DGTRACE) !,3.3
. . S VAIP("D")="LAST",VAIP("M")=1
. . D IN5^VADPT
. . ; Get ward. Use last movement if it exists, if not use the current movement.
. . N DGWARD S DGWARD=(+VAIP(14,4))
. . I $P($G(DGPMAN),"^",21)]"" N DGASIH D Q:$G(DGASIH)=3 ;Deleting discharge which relates to ASIH (312), modified p-373
. . . N DGOMDT,DGOWARD,DGOIEN
. . . S DGOMDT=+$G(DGPMAN) Q:DGOMDT'>0
. . . S DGOMDT=$O(^DGPM("APRD",DFN,DGOMDT),-1) Q:DGOMDT'>0 ;Get movement prior to ASIH
. . . S DGOIEN=$O(^DGPM("APRD",DFN,DGOMDT,0)) ;Get IEN of movement
. . . S DGOWARD=$$GET1^DIQ(405,DGOIEN,".06","I") Q:DGOWARD=""
. . . Q:'$$CHKWARD^DGRUUTL(DGOWARD) ;Quit if not RAI/MDS flag
. . . N DGLDDAT S DGLDDAT=$O(^DGPM("APTT3",DFN,""),-1) ;p-430
. . . I $G(DGLDDAT)]"",DGLDDAT>+$P($G(DGPMAN),"^"),DGLDDAT<+$G(DGNOW) Q ;p-430
. . . K DGLDDAT ;p-430
. . . S DGASIH=3 ;Set flag to identify ASIH (used by DGRUGA13)
. . . D BLDMSG^DGRUADT1(DFN,"A13",DGOIEN,+DGPMP,DGOWARD)
. . . N DGSTAT,DGIEN S DGSTAT="A" ;p-430
. . . S DGIEN=$O(^DGRU(46.14,DFN,1,"B",+$G(DGPMAN),0)) Q:DGIEN="" ;p-430
. . . D UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT) ;p-430
. . S:'DGWARD DGWARD=+VAIP(5)
. . Q:'$$CHKWARD^DGRUUTL(DGWARD)
. . D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARD)
. ;
. ; If DGTYPE=2, then deleting a transfer
. I (DGTYPE=2) S DGEVENT="A12" D Q
. . W:$D(DGTRACE) !,3.2
. . N DGWARDP,DGWARDA,VAIP
. . S DGWARDP=+$P(DGPMP,"^",6)
. . N VAIP S VAIP("D")="LAST",VAIP("M")=1
. . D IN5^VADPT
. . S DGWARDA=+VAIP(5)
. . I 'DGWARDP!('DGWARDA) D Q
. . . W !,"Unable to determine wards for transfer cancellation"
. . ;
. . ;Get Division for prior Ward
. . S DGPDIV=+$$GETDIV^DGRUUTL1(DGWARDP)
. . ;
. . ;Get Division for current Ward
. . S DGCDIV=+$$GETDIV^DGRUUTL1(DGWARDA)
. . ;
. . ;Get Integration flag
. . S DGINTEG=+$$GET1^DIQ(43,1,391.705,"I")
. . ;
. . ; If cancel transfer mds to mds ward: A12
. . I $$CHKWARD^DGRUUTL(DGWARDP)&($$CHKWARD^DGRUUTL(DGWARDA)) D Q
. . . I DGINTEG=1!(DGINTEG=2),DGPDIV'=DGCDIV D
. . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,DGWARDP)
. . . . D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARDA)
. . . E D ;
. . . . D BLDMSG^DGRUADT1(DFN,"A12",DGPMDA,+DGPMP,DGWARDP)
. . . . I DGMOVE=43 D DELASIH^DGRUASIH(DFN,VAFHDT) ;p-464
. . ; If cancel transfer to non-mds ward from an mds ward: A13
. . I '$$CHKWARD^DGRUUTL(DGWARDP)&($$CHKWARD^DGRUUTL(DGWARDA)) D Q
. . . D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARDP)
. . ; If cancel transfer to mds ward from an non-mds ward: A11
. . I $$CHKWARD^DGRUUTL(DGWARDP)&('$$CHKWARD^DGRUUTL(DGWARDA)) D Q
. . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,DGWARDP)
;
EVENTQ Q
;
SETVAR(NODE) ;
S DGTYPE=$P(NODE,"^",2),VAFHDT=$P(NODE,"^",1),DGADMSN=$P(NODE,"^",14)
Q
;
MOVETYPE(NODE) ;
N TYPE
S TYPE=$P(NODE,"^",18)
Q +$G(TYPE)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUADT 7867 printed Apr 09, 2024@21:57:04 Page 2
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
+2 ;
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
+2 ; the ADT message to the vendor.
+3 ; Input:
+4 ; DGPMP - 0 node of the primary movement BEFORE the ADT action
+5 ; DGPMA - 0 node of the primary movement AFTER the ADT action
+6 ; DFN - Ien of the patient in the PATIENT File (#2)
+7 ; DGPMDA - Ien of the movement
+8 ; DGQUIET - Flag to suppress read/writes if set
+9 ; DGADT - Data array for processing ADT events
+10 ; DGTRACE - Debugging parameter
+11 ; DGPDIV - Division for prior Ward
+12 ; DGCDIV - Division for current Ward
+13 ; DGINTEG - Integration Database flag
+14 ; 0 - Not Integrated Site
+15 ; 1 - Integrated, Single Database
+16 ; 2 - Integrated, Multiple Databases
+17 ; DGPMVI - Array where results from call to IN5^VADPT returned
+18 ;
+19 NEW DGTRACE,VAFH
+20 ;
+21 ; Test for ADT on/off parameter
+22 if '$PIECE($$SEND^VAFHUTL(),"^",2)
QUIT
+23 ;
+24 MERGE VAFH=^UTILITY("DGPM",$JOB)
+25 ;
+26 IF '($GET(DGQUIET))
Begin DoDot:1
+27 WRITE !,"Executing HL7 ADT Messaging (RAI/MDS)"
+28 IF $DATA(^TMP("DGRUADT1"))
SET DGTRACE=1
End DoDot:1
+29 IF $DATA(DGTRACE)
Begin DoDot:1
+30 DO INIT
End DoDot:1
GOTO EXIT
+31 ;
+32 NEW ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH,X,ZTQUEUED,ZTREQ
+33 SET ZTDESC="HL7 ADT MESSAGE (RAI/MDS)"
SET ZTRTN="EVENT^DGRUADT"
+34 FOR X="DGPMP","DGPMA","DGPMDA","DFN","DGPMAN","VAFH("
SET ZTSAVE(X)=""
+35 SET ZTIO=""
SET ZTDTH=$HOROLOG
+36 DO ^%ZTLOAD
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO KILL^HLTRANS
+3 KILL ^TMP("HLS",$JOB)
+4 QUIT
+5 ;
INIT ;
+1 DO EVENT
DO EXIT
+2 QUIT
+3 ;
EVENT ;
+1 NEW DGTYPE,DGMOVE,DGADMSN,VAFHDT,DGEVENT,VAIP
+2 ;
+3 ; Check for valid movements
+4 IF $GET(DGPMP)=""&($GET(DGPMA)="")
QUIT
+5 ;
+6 ; Determine the event transaction type. The events are:
+7 ;
+8 ; If DGPMP is null and DGPMA is not, then adding a new ADT event
+9 IF (DGPMP="")&(DGPMA'="")
Begin DoDot:1
+10 DO SETVAR(DGPMA)
+11 ;
+12 ; If DGTYPE=6, then this a treating specialty change, check if this is for
+13 ; a provider change.
+14 IF (DGTYPE=6)
Begin DoDot:2
+15 NEW VAIN,VAINDT
+16 SET VAINDT=+DGPMA
+17 DO INP^VADPT
+18 ; I (+VAIN(2)=+$G(DGPMVI(7)))&(+VAIN(11)=+$G(DGPMVI(18))) Q p-721
+19 if '$$CHKWARD^DGRUUTL(+$GET(DGPMVI(5)))
QUIT
+20 if $DATA(DGTRACE)
WRITE !,1.6
+21 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGPMVI(5))
End DoDot:2
QUIT
+22 ;
+23 ; If DGTYPE=1, then it means an admission
+24 IF (DGTYPE=1)
SET DGEVENT="A01"
Begin DoDot:2
+25 if $DATA(DGTRACE)
WRITE !,1.1
+26 if '$$CHKWARD^DGRUUTL(+$PIECE(DGPMA,"^",6))
QUIT
+27 DO BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:2
QUIT
+28 ;
+29 ; If DGTYPE=3, then it means a discharge
+30 IF (DGTYPE=3)
SET DGEVENT="A03"
Begin DoDot:2
+31 if $DATA(DGTRACE)
WRITE !,1.3
+32 SET DGMOVE=$$MOVETYPE(DGPMA)
+33 ;
+34 ;If Movement type "From ASIH" create A22 and send to COTS
+35 IF DGMOVE=41!(DGMOVE=14)
DO MV41^DGRUADT0(DFN)
QUIT
+36 ;
+37 ; Get ward discharged from, if RAI/MDS, then process message
+38 NEW VAIP
SET VAIP("D")="LAST"
+39 DO IN5^VADPT
+40 ;If Movement type "Death" must check to see if patient was ASIH
+41 ;If patient was ASIH, create and send A03 to COTS
+42 ;modified p-373
IF $PIECE($GET(DGPMAN),"^",21)]""
NEW DGASIH
DO MV1238^DGRUADT0(DFN)
if $GET(DGASIH)=1
QUIT
+43 ;
+44 if '$$CHKWARD^DGRUUTL(+VAIP(17,4))
QUIT
+45 DO BLDMSG^DGRUADT1(DFN,"A03",DGPMDA,+DGPMA,+VAIP(17,4))
End DoDot:2
QUIT
+46 ;
+47 ; If DGTYPE=2, then it means a transfer
+48 IF (DGTYPE=2)
SET DGEVENT="A02"
Begin DoDot:2
+49 if $DATA(DGTRACE)
WRITE !,1.2
+50 SET DGMOVE=$$MOVETYPE(DGPMA)
+51 ;
+52 ; If transfer to ASIH
+53 IF DGMOVE=13!(DGMOVE=43)!(DGMOVE=40)
DO MV40^DGRUADT0(DFN)
QUIT
+54 ;
+55 ;If transfer From ASIH
+56 IF DGMOVE=14!(DGMOVE=41)
DO MV41^DGRUADT0(DFN)
QUIT
+57 ; If transfer is to Leave of absence
+58 ;modified p-328
IF DGMOVE=1!(DGMOVE=2)!(DGMOVE=3)
Begin DoDot:3
+59 if '$$CHKWARD^DGRUUTL(+$PIECE(DGPMA,"^",6))
QUIT
+60 DO BLDMSG^DGRUADT1(DFN,"A21",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:3
QUIT
+61 ;
+62 ; If transfer is from Leave of absence
+63 IF DGMOVE=23!(DGMOVE=24)!(DGMOVE=22)
Begin DoDot:3
+64 if '$$CHKWARD^DGRUUTL(+$PIECE(DGPMA,"^",6))
QUIT
+65 DO BLDMSG^DGRUADT1(DFN,"A22",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:3
QUIT
+66 ;
+67 IF DGMOVE=4
DO MV4^DGRUADT0(DFN,DGPMA)
End DoDot:2
QUIT
+68 ;
End DoDot:1
GOTO EVENTQ
+69 ;
+70 ; If DGPMP and DGPMA are both NOT null, then editing an ADT event
+71 IF (DGPMP'="")&(DGPMA'="")
DO EDITADT^DGRUADT2
GOTO EVENTQ
+72 ;
+73 ; If DGPMP is not null and DGPMA is, then deleting an ADT event
+74 IF (DGPMP'="")&(DGPMA="")
Begin DoDot:1
+75 DO SETVAR(DGPMP)
+76 SET DGMOVE=$$MOVETYPE(DGPMP)
+77 ;
+78 ; If DGTYPE=1, then deleting an admission
+79 IF (DGTYPE=1)
SET DGEVENT="A11"
Begin DoDot:2
+80 if $DATA(DGTRACE)
WRITE !,3.1
+81 ;Check if deleting an admission for an ASIH event
+82 IF DGMOVE=13!(DGMOVE=43)!(DGMOVE=40)
DO CN40^DGRUADT0(DFN)
QUIT
+83 ;Quit if not RAI/MDS ward
if '$$CHKWARD^DGRUUTL(+$PIECE(DGPMP,"^",6))
QUIT
+84 ;
+85 DO BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6))
End DoDot:2
QUIT
+86 ;
+87 ; If DGTYPE=3, then deleting a discharge
+88 IF (DGTYPE=3)
SET DGEVENT="A13"
Begin DoDot:2
+89 if $DATA(DGTRACE)
WRITE !,3.3
+90 SET VAIP("D")="LAST"
SET VAIP("M")=1
+91 DO IN5^VADPT
+92 ; Get ward. Use last movement if it exists, if not use the current movement.
+93 NEW DGWARD
SET DGWARD=(+VAIP(14,4))
+94 ;Deleting discharge which relates to ASIH (312), modified p-373
IF $PIECE($GET(DGPMAN),"^",21)]""
NEW DGASIH
Begin DoDot:3
+95 NEW DGOMDT,DGOWARD,DGOIEN
+96 SET DGOMDT=+$GET(DGPMAN)
if DGOMDT'>0
QUIT
+97 ;Get movement prior to ASIH
SET DGOMDT=$ORDER(^DGPM("APRD",DFN,DGOMDT),-1)
if DGOMDT'>0
QUIT
+98 ;Get IEN of movement
SET DGOIEN=$ORDER(^DGPM("APRD",DFN,DGOMDT,0))
+99 SET DGOWARD=$$GET1^DIQ(405,DGOIEN,".06","I")
if DGOWARD=""
QUIT
+100 ;Quit if not RAI/MDS flag
if '$$CHKWARD^DGRUUTL(DGOWARD)
QUIT
+101 ;p-430
NEW DGLDDAT
SET DGLDDAT=$ORDER(^DGPM("APTT3",DFN,""),-1)
+102 ;p-430
IF $GET(DGLDDAT)]""
IF DGLDDAT>+$PIECE($GET(DGPMAN),"^")
IF DGLDDAT<+$GET(DGNOW)
QUIT
+103 ;p-430
KILL DGLDDAT
+104 ;Set flag to identify ASIH (used by DGRUGA13)
SET DGASIH=3
+105 DO BLDMSG^DGRUADT1(DFN,"A13",DGOIEN,+DGPMP,DGOWARD)
+106 ;p-430
NEW DGSTAT,DGIEN
SET DGSTAT="A"
+107 ;p-430
SET DGIEN=$ORDER(^DGRU(46.14,DFN,1,"B",+$GET(DGPMAN),0))
if DGIEN=""
QUIT
+108 ;p-430
DO UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT)
End DoDot:3
if $GET(DGASIH)=3
QUIT
+109 if 'DGWARD
SET DGWARD=+VAIP(5)
+110 if '$$CHKWARD^DGRUUTL(DGWARD)
QUIT
+111 DO BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARD)
End DoDot:2
QUIT
+112 ;
+113 ; If DGTYPE=2, then deleting a transfer
+114 IF (DGTYPE=2)
SET DGEVENT="A12"
Begin DoDot:2
+115 if $DATA(DGTRACE)
WRITE !,3.2
+116 NEW DGWARDP,DGWARDA,VAIP
+117 SET DGWARDP=+$PIECE(DGPMP,"^",6)
+118 NEW VAIP
SET VAIP("D")="LAST"
SET VAIP("M")=1
+119 DO IN5^VADPT
+120 SET DGWARDA=+VAIP(5)
+121 IF 'DGWARDP!('DGWARDA)
Begin DoDot:3
+122 WRITE !,"Unable to determine wards for transfer cancellation"
End DoDot:3
QUIT
+123 ;
+124 ;Get Division for prior Ward
+125 SET DGPDIV=+$$GETDIV^DGRUUTL1(DGWARDP)
+126 ;
+127 ;Get Division for current Ward
+128 SET DGCDIV=+$$GETDIV^DGRUUTL1(DGWARDA)
+129 ;
+130 ;Get Integration flag
+131 SET DGINTEG=+$$GET1^DIQ(43,1,391.705,"I")
+132 ;
+133 ; If cancel transfer mds to mds ward: A12
+134 IF $$CHKWARD^DGRUUTL(DGWARDP)&($$CHKWARD^DGRUUTL(DGWARDA))
Begin DoDot:3
+135 IF DGINTEG=1!(DGINTEG=2)
IF DGPDIV'=DGCDIV
Begin DoDot:4
+136 DO BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,DGWARDP)
+137 DO BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARDA)
End DoDot:4
+138 ;
IF '$TEST
Begin DoDot:4
+139 DO BLDMSG^DGRUADT1(DFN,"A12",DGPMDA,+DGPMP,DGWARDP)
+140 ;p-464
IF DGMOVE=43
DO DELASIH^DGRUASIH(DFN,VAFHDT)
End DoDot:4
End DoDot:3
QUIT
+141 ; If cancel transfer to non-mds ward from an mds ward: A13
+142 IF '$$CHKWARD^DGRUUTL(DGWARDP)&($$CHKWARD^DGRUUTL(DGWARDA))
Begin DoDot:3
+143 DO BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,DGWARDP)
End DoDot:3
QUIT
+144 ; If cancel transfer to mds ward from an non-mds ward: A11
+145 IF $$CHKWARD^DGRUUTL(DGWARDP)&('$$CHKWARD^DGRUUTL(DGWARDA))
Begin DoDot:3
+146 DO BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,DGWARDP)
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
GOTO EVENTQ
+147 ;
EVENTQ QUIT
+1 ;
SETVAR(NODE) ;
+1 SET DGTYPE=$PIECE(NODE,"^",2)
SET VAFHDT=$PIECE(NODE,"^",1)
SET DGADMSN=$PIECE(NODE,"^",14)
+2 QUIT
+3 ;
MOVETYPE(NODE) ;
+1 NEW TYPE
+2 SET TYPE=$PIECE(NODE,"^",18)
+3 QUIT +$GET(TYPE)
