- 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 Feb 19, 2025@00:24:02 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)