DGRUADT2 ;ALB/GRR - Logic for editing admit, discharge, or transfer; 7-8-99
;;5.3;Registration;**190,328,373,430**;Aug 13, 1993
;
EDITADT ; Entry point for generating HL7 ADT messages to the COTS system
; whenever an existing patient movement is edited. Multiple messages
; may be created and sent 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
; DGPPMDA - Ien of prior 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
; DGLMT - Last Movement flag
; 1 - Created multiple HL7 transactions
; DGCTRAN - 1 - Changing Transfer data, must move
; prior location to current location
;
N DGCTRAN,DGLMT,DGINTEG,DGMOVE
S (DGCTRAN,DGLMT)=0
D SETVAR^DGRUADT(DGPMA)
S DGMOVE=$$MOVETYPE^DGRUADT(DGPMA)
S DGINTEG=$$GET1^DIQ(43,1,391.705,"I")
;
; If DGTYPE=6, then this a treating specialty change, check if this isfor
; 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
. Q:'$$CHKWARD^DGRUUTL(+$G(DGPMVI(5)))
. W:$D(DGTRACE) !,2.6
. D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGPMVI(5))
;
; If DGTYPE=1, then editing an existing admission
I (DGTYPE=1) S DGEVENT="A08" D Q
. W:$D(DGTRACE) !,2.1
. Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))&('$$CHKWARD^DGRUUTL(+$P(DGPMP,"^",6)))
. ; Check for ward location change
. I $P(DGPMP,"^",6)'=$P(DGPMA,"^",6) D Q
. . I $$CHKWARD^DGRUUTL($P(DGPMP,"^",6)) D
. . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,$P(DGPMP,"^",6))
. . Q:'$$CHKWARD^DGRUUTL($P(DGPMA,"^",6))
. . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,$P(DGPMA,"^",6))
. ; Check for edit to admission date, if edited send A08 with date change
. I '(+DGPMA=+DGPMP) D Q
. . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPMP,"^",6),+DGPMP,"A")
. ;If Bed switch, create an A02
. I ($P(DGPMA,"^",6)=$P(DGPMP,"^",6)),($P(DGPMA,"^",7)'=$P(DGPMP,"^",7)) D Q
. . D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
. ; Just need an regular A08
. D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
;
; If DGTYPE=3, then editing an existing discharge
I (DGTYPE=3) S DGEVENT="A08" D Q
. N DGTIEN
. W:$D(DGTRACE) !,2.3
. N DGRU,VAROOT
. S VAIP("D")="LAST",VAROOT="DGRU"
. D IN5^VADPT
. K VAROOT
. I $$CHKWARD^DGRUUTL(+DGRU(17,4))&(DGMOVE'=42) D Q ;P-430
. . N DGASIH S DGASIH=1 ;p-430
. . D BLDMSG^DGRUADT1(DFN,"A03",$G(DGPMDA),+DGRU(17,4)) ;p-430
. . N DGIEN S DGIEN=$O(^DGRU(46.14,DFN,1,"B",+$G(DGPM0),0)) Q:DGIEN="" ;p-430
. . N DGSTAT S DGSTAT="I" ;p-430
. . D UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT) ;p-430
. I DGMOVE=47 D Q ;p-430
. . N DGTIEN ;p-430
. . S DGTIEN=$$FLLTCM^DGRUUTL1(DFN) ;p-430
. . Q:DGTIEN="" ;p-430
. . S DGRU(17,4)=$P(^DGPM(DGTIEN,0),"^",6,7) ;p-430
. . Q:'$$CHKWARD^DGRUUTL(+DGRU(17,4)) ;p-430
. . N DGASIH S DGASIH=1 ;p-430
. . D BLDMSG^DGRUADT1(DFN,"A03",DGTIEN,+DGRU(17,4))
. . N DGIEN S DGIEN=$O(^DGRU(46.14,DFN,1,"B",+$G(DGPM0),0)) Q:DGIEN="" ;p-373
. . N DGSTAT S DGSTAT="I" ;p-373
. . D UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT) ;p-373
.; Q:'$$CHKWARD^DGRUUTL(+DGRU(17,4)) p-430
. ; Check for edit to discharge date, if edited send modified a08
. I '(+DGPMA=+DGPMP) D Q
. . I DGMOVE=42 D Q ;p-373
. . . N DGNOW D NOW^%DTC S DGNOW=% ;p-373
. . . I +$G(DGPMP)<DGNOW D ;p-373
. . . . N DGASIH S DGASIH=3 ;p-373
. . . . N DGTIEN S DGTIEN=$$FLLTCM^DGRUUTL1(DFN) Q:DGTIEN="" ;p-430
. . . . D BLDMSG^DGRUADT1(DFN,"A13",DGTIEN,+^DGPM(DGTIEN,0),+$P(^DGPM(DGTIEN,0),"^",6)) ;p-430
. . . . N DGSTAT,DGIEN S DGSTAT="A" ;p-373
. . . . S DGIEN=$O(^DGRU(46.14,DFN,1,"B",+$G(DGPM0),0)) Q:DGIEN="" ;p-373
. . . . D UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT) ;p-373
. . Q:'$$CHKWARD^DGRUUTL(+DGRU(17,4)) ;p-430
. . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGRU(17,4),+DGPMP,"D")
. E D
. . Q:'$$CHKWARD^DGRUUTL(+DGRU(17,4)) ;p-430
. . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGRU(17,4))
;
; If DGTYPE=2, then editng an existing transfer
I (DGTYPE=2) S DGEVENT="A08" D Q
. W:$D(DGTRACE) !,2.2
. Q:'$$CHKWARD^DGRUUTL(+$P(DGPMA,"^",6))
. S DGLMT=0
. I $$CHKWARD^DGRUUTL($P(DGPMP,"^",6)) D
. . Q:DGINTEG'=1&(DGINTEG'=2) ;Not an integrated database
. . Q:'$D(DGPM0) ;No prior movements
. . Q:'$$CHKWARD^DGRUUTL($P(DGPM0,"^",6)) ;Not RAI/MDS ward
. . I +$$GETDIV^DGRUUTL1($P(DGPMP,"^",6))'=+$$GETDIV^DGRUUTL1($P(DGPM0,"^",6)) D ;Multiple transactions done last time
. . . S DGLMT=1
. ;
. I $P(DGPMP,"^",6)'=$P(DGPMA,"^",6) D Q ;Ward changed
. . I +$$GETDIV^DGRUUTL1($P(DGPMP,"^",6))'=+$$GETDIV^DGRUUTL1($P(DGPMA,"^",6)) D
. . . I +$$GETDIV^DGRUUTL1($P(DGPMA,"^",6))=+$$GETDIV^DGRUUTL1($P(DGPM0,"^",6)) D ;now same division as original ward, cancel dc and admit, send A02
. . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
. . . . S DGCTRAN=1 D BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
. . . . D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
. . . E D
. . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
. . . . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
. . E D
. . . S DGCTRAN=1
. . . I 'DGLMT D
. . . . D BLDMSG^DGRUADT1(DFN,"A12",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
. . . . D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
. . . E D
. . . . D BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$P(DGPMP,"^",6))
. . . . D BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
. . . . I +DGPMP'=+DGPMA D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPMP,"^",6),+DGPMP,"D") ;date also changed, update discharge date in other entity
. ;
. ; Check for edit to transfer date, if edited send modified A08
. I '(+DGPMA=+DGPMP) D Q
. . I 'DGLMT D ;Just send one A08 to change transfer date
. . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPMP,"^",6),+DGPMP,"T")
. . E D
. . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPMP,"^",6),+DGPMP,"A")
. . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$P(DGPM0,"^",6),+DGPMP,"D")
. E D
. . ; The following checks for the special case of a bed switch following a transfer
. . ; in the movement sequence. Bed switch requires an "A02"
. . I ($P(DGPMA,"^",6)=$P(DGPMP,"^",6)),($P(DGPMA,"^",7)'=$P(DGPMP,"^",7)) D
. . . D BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
. . E D ; Process straight interward transfer with no special cases
. . . D BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+$P(DGPMA,"^",6))
;
EXIT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUADT2 7194 printed Nov 22, 2024@18:08:02 Page 2
DGRUADT2 ;ALB/GRR - Logic for editing admit, discharge, or transfer; 7-8-99
+1 ;;5.3;Registration;**190,328,373,430**;Aug 13, 1993
+2 ;
EDITADT ; Entry point for generating HL7 ADT messages to the COTS system
+1 ; whenever an existing patient movement is edited. Multiple messages
+2 ; may be created and sent 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 ; DGPPMDA - Ien of prior movement
+9 ; DGQUIET - Flag to suppress read/writes if set
+10 ; DGADT - Data array for processing ADT events
+11 ; DGTRACE - Debugging parameter
+12 ; DGPDIV - Division for prior Ward
+13 ; DGCDIV - Division for current Ward
+14 ; DGINTEG - Integration Database flag
+15 ; 0 - Not Integrated Site
+16 ; 1 - Integrated, Single Database
+17 ; 2 - Integrated, Multiple Databases
+18 ; DGLMT - Last Movement flag
+19 ; 1 - Created multiple HL7 transactions
+20 ; DGCTRAN - 1 - Changing Transfer data, must move
+21 ; prior location to current location
+22 ;
+23 NEW DGCTRAN,DGLMT,DGINTEG,DGMOVE
+24 SET (DGCTRAN,DGLMT)=0
+25 DO SETVAR^DGRUADT(DGPMA)
+26 SET DGMOVE=$$MOVETYPE^DGRUADT(DGPMA)
+27 SET DGINTEG=$$GET1^DIQ(43,1,391.705,"I")
+28 ;
+29 ; If DGTYPE=6, then this a treating specialty change, check if this isfor
+30 ; a provider change.
+31 IF (DGTYPE=6)
Begin DoDot:1
+32 NEW VAIN,VAINDT
+33 SET VAINDT=+DGPMA
+34 DO INP^VADPT
+35 IF (+VAIN(2)=+$GET(DGPMVI(7)))&(+VAIN(11)=+$GET(DGPMVI(18)))
QUIT
+36 if '$$CHKWARD^DGRUUTL(+$GET(DGPMVI(5)))
QUIT
+37 if $DATA(DGTRACE)
WRITE !,2.6
+38 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGPMVI(5))
End DoDot:1
QUIT
+39 ;
+40 ; If DGTYPE=1, then editing an existing admission
+41 IF (DGTYPE=1)
SET DGEVENT="A08"
Begin DoDot:1
+42 if $DATA(DGTRACE)
WRITE !,2.1
+43 if '$$CHKWARD^DGRUUTL(+$PIECE(DGPMA,"^",6))&('$$CHKWARD^DGRUUTL(+$PIECE(DGPMP,"^",6)))
QUIT
+44 ; Check for ward location change
+45 IF $PIECE(DGPMP,"^",6)'=$PIECE(DGPMA,"^",6)
Begin DoDot:2
+46 IF $$CHKWARD^DGRUUTL($PIECE(DGPMP,"^",6))
Begin DoDot:3
+47 DO BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,$PIECE(DGPMP,"^",6))
End DoDot:3
+48 if '$$CHKWARD^DGRUUTL($PIECE(DGPMA,"^",6))
QUIT
+49 DO BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,$PIECE(DGPMA,"^",6))
End DoDot:2
QUIT
+50 ; Check for edit to admission date, if edited send A08 with date change
+51 IF '(+DGPMA=+DGPMP)
Begin DoDot:2
+52 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6),+DGPMP,"A")
End DoDot:2
QUIT
+53 ;If Bed switch, create an A02
+54 IF ($PIECE(DGPMA,"^",6)=$PIECE(DGPMP,"^",6))
IF ($PIECE(DGPMA,"^",7)'=$PIECE(DGPMP,"^",7))
Begin DoDot:2
+55 DO BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:2
QUIT
+56 ; Just need an regular A08
+57 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:1
QUIT
+58 ;
+59 ; If DGTYPE=3, then editing an existing discharge
+60 IF (DGTYPE=3)
SET DGEVENT="A08"
Begin DoDot:1
+61 NEW DGTIEN
+62 if $DATA(DGTRACE)
WRITE !,2.3
+63 NEW DGRU,VAROOT
+64 SET VAIP("D")="LAST"
SET VAROOT="DGRU"
+65 DO IN5^VADPT
+66 KILL VAROOT
+67 ;P-430
IF $$CHKWARD^DGRUUTL(+DGRU(17,4))&(DGMOVE'=42)
Begin DoDot:2
+68 ;p-430
NEW DGASIH
SET DGASIH=1
+69 ;p-430
DO BLDMSG^DGRUADT1(DFN,"A03",$GET(DGPMDA),+DGRU(17,4))
+70 ;p-430
NEW DGIEN
SET DGIEN=$ORDER(^DGRU(46.14,DFN,1,"B",+$GET(DGPM0),0))
if DGIEN=""
QUIT
+71 ;p-430
NEW DGSTAT
SET DGSTAT="I"
+72 ;p-430
DO UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT)
End DoDot:2
QUIT
+73 ;p-430
IF DGMOVE=47
Begin DoDot:2
+74 ;p-430
NEW DGTIEN
+75 ;p-430
SET DGTIEN=$$FLLTCM^DGRUUTL1(DFN)
+76 ;p-430
if DGTIEN=""
QUIT
+77 ;p-430
SET DGRU(17,4)=$PIECE(^DGPM(DGTIEN,0),"^",6,7)
+78 ;p-430
if '$$CHKWARD^DGRUUTL(+DGRU(17,4))
QUIT
+79 ;p-430
NEW DGASIH
SET DGASIH=1
+80 DO BLDMSG^DGRUADT1(DFN,"A03",DGTIEN,+DGRU(17,4))
+81 ;p-373
NEW DGIEN
SET DGIEN=$ORDER(^DGRU(46.14,DFN,1,"B",+$GET(DGPM0),0))
if DGIEN=""
QUIT
+82 ;p-373
NEW DGSTAT
SET DGSTAT="I"
+83 ;p-373
DO UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT)
End DoDot:2
QUIT
+84 ; Q:'$$CHKWARD^DGRUUTL(+DGRU(17,4)) p-430
+85 ; Check for edit to discharge date, if edited send modified a08
+86 IF '(+DGPMA=+DGPMP)
Begin DoDot:2
+87 ;p-373
IF DGMOVE=42
Begin DoDot:3
+88 ;p-373
NEW DGNOW
DO NOW^%DTC
SET DGNOW=%
+89 ;p-373
IF +$GET(DGPMP)<DGNOW
Begin DoDot:4
+90 ;p-373
NEW DGASIH
SET DGASIH=3
+91 ;p-430
NEW DGTIEN
SET DGTIEN=$$FLLTCM^DGRUUTL1(DFN)
if DGTIEN=""
QUIT
+92 ;p-430
DO BLDMSG^DGRUADT1(DFN,"A13",DGTIEN,+^DGPM(DGTIEN,0),+$PIECE(^DGPM(DGTIEN,0),"^",6))
+93 ;p-373
NEW DGSTAT,DGIEN
SET DGSTAT="A"
+94 ;p-373
SET DGIEN=$ORDER(^DGRU(46.14,DFN,1,"B",+$GET(DGPM0),0))
if DGIEN=""
QUIT
+95 ;p-373
DO UPSTAT^DGRUASIH(DFN,DGIEN,DGSTAT)
End DoDot:4
End DoDot:3
QUIT
+96 ;p-430
if '$$CHKWARD^DGRUUTL(+DGRU(17,4))
QUIT
+97 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGRU(17,4),+DGPMP,"D")
End DoDot:2
QUIT
+98 IF '$TEST
Begin DoDot:2
+99 ;p-430
if '$$CHKWARD^DGRUUTL(+DGRU(17,4))
QUIT
+100 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+DGRU(17,4))
End DoDot:2
End DoDot:1
QUIT
+101 ;
+102 ; If DGTYPE=2, then editng an existing transfer
+103 IF (DGTYPE=2)
SET DGEVENT="A08"
Begin DoDot:1
+104 if $DATA(DGTRACE)
WRITE !,2.2
+105 if '$$CHKWARD^DGRUUTL(+$PIECE(DGPMA,"^",6))
QUIT
+106 SET DGLMT=0
+107 IF $$CHKWARD^DGRUUTL($PIECE(DGPMP,"^",6))
Begin DoDot:2
+108 ;Not an integrated database
if DGINTEG'=1&(DGINTEG'=2)
QUIT
+109 ;No prior movements
if '$DATA(DGPM0)
QUIT
+110 ;Not RAI/MDS ward
if '$$CHKWARD^DGRUUTL($PIECE(DGPM0,"^",6))
QUIT
+111 ;Multiple transactions done last time
IF +$$GETDIV^DGRUUTL1($PIECE(DGPMP,"^",6))'=+$$GETDIV^DGRUUTL1($PIECE(DGPM0,"^",6))
Begin DoDot:3
+112 SET DGLMT=1
End DoDot:3
End DoDot:2
+113 ;
+114 ;Ward changed
IF $PIECE(DGPMP,"^",6)'=$PIECE(DGPMA,"^",6)
Begin DoDot:2
+115 IF +$$GETDIV^DGRUUTL1($PIECE(DGPMP,"^",6))'=+$$GETDIV^DGRUUTL1($PIECE(DGPMA,"^",6))
Begin DoDot:3
+116 ;now same division as original ward, cancel dc and admit, send A02
IF +$$GETDIV^DGRUUTL1($PIECE(DGPMA,"^",6))=+$$GETDIV^DGRUUTL1($PIECE(DGPM0,"^",6))
Begin DoDot:4
+117 DO BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6))
+118 SET DGCTRAN=1
DO BLDMSG^DGRUADT1(DFN,"A13",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6))
+119 DO BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:4
+120 IF '$TEST
Begin DoDot:4
+121 DO BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6))
+122 DO BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:4
End DoDot:3
+123 IF '$TEST
Begin DoDot:3
+124 SET DGCTRAN=1
+125 IF 'DGLMT
Begin DoDot:4
+126 DO BLDMSG^DGRUADT1(DFN,"A12",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6))
+127 DO BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:4
+128 IF '$TEST
Begin DoDot:4
+129 DO BLDMSG^DGRUADT1(DFN,"A11",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6))
+130 DO BLDMSG^DGRUADT1(DFN,"A01",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
+131 ;date also changed, update discharge date in other entity
IF +DGPMP'=+DGPMA
DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6),+DGPMP,"D")
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+132 ;
+133 ; Check for edit to transfer date, if edited send modified A08
+134 IF '(+DGPMA=+DGPMP)
Begin DoDot:2
+135 ;Just send one A08 to change transfer date
IF 'DGLMT
Begin DoDot:3
+136 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6),+DGPMP,"T")
End DoDot:3
+137 IF '$TEST
Begin DoDot:3
+138 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$PIECE(DGPMP,"^",6),+DGPMP,"A")
+139 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMP,+$PIECE(DGPM0,"^",6),+DGPMP,"D")
End DoDot:3
End DoDot:2
QUIT
+140 IF '$TEST
Begin DoDot:2
+141 ; The following checks for the special case of a bed switch following a transfer
+142 ; in the movement sequence. Bed switch requires an "A02"
+143 IF ($PIECE(DGPMA,"^",6)=$PIECE(DGPMP,"^",6))
IF ($PIECE(DGPMA,"^",7)'=$PIECE(DGPMP,"^",7))
Begin DoDot:3
+144 DO BLDMSG^DGRUADT1(DFN,"A02",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:3
+145 ; Process straight interward transfer with no special cases
IF '$TEST
Begin DoDot:3
+146 DO BLDMSG^DGRUADT1(DFN,"A08",DGPMDA,+DGPMA,+$PIECE(DGPMA,"^",6))
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+147 ;
EXIT QUIT
