VAFCADT1 ;ALB/RJS - HL7 PATIENT MOVEMENT EVENTS - APRIL 13,1995 ; 7/12/04 1:49pm
;;5.3;Registration;**91,179,992**;Aug 13, 1993;Build 5
;HL7v1.6
;This Routine is executed as an item protocol on the DGPM Patient
;Movement Event Driver. It's purpose is to determine what event
;has occurred. Has an Admission been created ? Has a Transfer with
;an associated Specialty Transfer been deleted ? This routine
;contains the logic to determine this.
;
;In certain instances, one HL7 message will be sent. In other
;instances portions (or the entire) history of an admission may
;be sent.
;
;A Portion of the history will be sent, if that portion
;is affected by the insertion or deletion of an event.
;
;You can run this software in the foreground and turn on a trace of
;this software, by defining the node ^TMP("VAFCADT1",$J)
;
Q:'$P($$SEND^VAFHUTL(),"^",2)
;S ^TMP("VAFCADT1",$J)=1
N VATRACE,VAFH
MERGE VAFH=^UTILITY("DGPM",$J)
I '($G(DGQUIET)) D
. W !,"Executing HL7 ADT Messaging"
. I $D(^TMP("VAFCADT1",$J)) S VATRACE=1
; DG*5.3*992 - Call INITIZE directly instead of queuing to avoid timing issues when reinstating orders after readmission from observation ward
D INITIZE
;I $D(VATRACE) D G EXIT
;. D INITIZE
;N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH
;S ZTDESC="HL7 ADT MESSAGE",ZTRTN="INITIZE^VAFCADT1",ZTSAVE("DGPMP")="",ZTSAVE("DGPMA")="",ZTIO="",ZTSAVE("DGPMDA")="",ZTSAVE("DFN")="",ZTDTH=$H,ZTSAVE("VAFH(")=""
;D ^%ZTLOAD
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
D KILL^HLTRANS
K ^TMP("HLS",$J)
Q
;
INITIZE ;;;can't do v1.6 it here, need event for init
;S HLNDAP="PIMS HL7" D INIT^HLTRANS
;S HLNDAP="PIMS HL7" D INIT^HLFNC2("VAFH "_EVENT,.HL)
;I $D(HLERR) Q
;I $D(HL)<2 Q
D EVENT,EXIT
Q
EVENT ;
I $G(DGPMP)=""&($G(DGPMA)="") Q
N EVENT,TYPE,VAFHDT,ADMSSN,ADMDATE,IEN,PIVOT,PIVCHK,HISTORY
N OLDDATE,PV1,GARBAGE,MOVETYPE
;
;I DGPMP="" and DGPMA'="" it means we're adding a new ADMISSION,
;TRANSFER, DISCHARGE, or SPECIALTY TRANSFER to the Patient Movement
;File
;
I (DGPMP="")&(DGPMA'="") D G EXIT
. ;
. D SETVARS^VAFCADT4(DGPMA,DGPMDA) ; TYPE,VAFHDT,ADMSSN,IEN
. ;
. ;I TYPE=3 it means we're inserting a DISCHARGE
. ;
. I (TYPE=3) S EVENT="A03" D Q
. . W:$D(VATRACE) !,1.3
. . S MOVETYPE=$$MOVETYPE^VAFCADT4(DGPMA)
. . I MOVETYPE=41 D 41^VAFCADT5(DFN) Q
. . I MOVETYPE=46 D 46^VAFCADT5(DFN) Q
. . S PIVCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(ADMSSN),1,ADMSSN_";DGPM(")
. . S PIVOT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(ADMSSN),1,ADMSSN_";DGPM(")
. . I +PIVCHK>0 D BLDMSG^VAFCADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT) Q
. . K HISTORY
. . D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
. . D ENTIRE^VAFCADT4(+PIVOT)
. ;
. ;I TYPE=1 it means we're inserting an ADMISSION
. ;
. I (TYPE=1) D Q
. . W:$D(VATRACE) !,1.1
. . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
. . D BLDMSG^VAFCADT2(DFN,"A01",VAFHDT,"05",IEN,+PIVOT)
. ;
. ;I TYPE=2 it means we're inserting a TRANSFER
. ;
. I (TYPE=2) D Q
. . W:$D(VATRACE) !,1.2
. . S MOVETYPE=$$MOVETYPE^VAFCADT4(DGPMA)
. . I MOVETYPE=13 D 13^VAFCADT5(DFN) Q
. . I MOVETYPE=14 D 14^VAFCADT5(DFN) Q
. . I MOVETYPE=43 D 43^VAFCADT5(DFN) Q
. . I MOVETYPE=44 D 44^VAFCADT5(DFN) Q
. . K HISTORY
. . D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
. . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
. . D ADDING^VAFCADT4(DFN,"A02",VAFHDT,+PIVOT,+PIVCHK) Q
. ;
. ;I TYPE=6 it means we're inserting a standalone SPECIALTY TRANSFER
. ;
. I (TYPE=6) D Q
. . W:$D(VATRACE) !,1.6
. . K HISTORY
. . D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
. . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
. . D ADDING^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT,+PIVCHK) Q
;
;If DGPMP'="" and DGPMA'="" it means we're editing an existing
;ADMISSION, DISCHARGE, TRANSFER, or SPECIALTY TRANSFER
;
I (DGPMP'="")&(DGPMA'="") D G EXIT
. ;
. D SETVARS^VAFCADT4(DGPMA,DGPMDA)
. S EVENT="A08",OLDDATE=$P(DGPMP,"^",1)
. K HISTORY
. D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
. I '$D(HISTORY) Q
. ;
. ;I TYPE=1 it means we're editing an existing ADMISSION
. ;
. I (TYPE=1) D Q
. . W:$D(VATRACE) !,2.1
. . ;
. . ;If the DATE/TIME of the admission is one of the fields
. . ;that's been edited, it demands special treatment
. . ;
. . I VAFHDT'=OLDDATE D Q
. . . K HL D INIT^HLFNC2("VAFC ADT-A11 SERVER",.HL) ; doit here before dgbuild
. . . I $D(HL)#2 Q
. . . S PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,18,44,45")
. . . S PIVCHK=$$PIVCHK^VAFHPIVT(DFN,OLDDATE,1,ADMSSN_";DGPM(")
. . . ;
. . . I +PIVCHK>0 D
. . . . S PIVOT=$$PIVNW^VAFHPIVT(DFN,OLDDATE,1,ADMSSN_";DGPM(")
. . . . D BLDMSG^VAFCADT2(DFN,"A11",OLDDATE,"05","",+PIVOT,PV1)
. . . . S GARBAGE=$$UPDATE^VAFHUTL(+PIVOT,"","",1)
. . . S PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
. . . D:+PIVOT>0 ENTIRE^VAFCADT4(+PIVOT)
. . ;
. . I VAFHDT=OLDDATE D Q
. . . ;
. . . D PIVINIT^VAFCADT4(DFN,VAFHDT,ADMSSN)
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT) Q
. ;
. ;I TYPE=2 it means we're editing an existing TRANSFER
. ;
. I (TYPE=2) D Q
. . W:$D(VATRACE) !,2.2
. . ;
. . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
. . ;
. . I VAFHDT'=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D Q
. . . . D DELETE^VAFCADT4(DFN,"A12",OLDDATE,+PIVOT,2.2)
. . . . D INSERT^VAFCADT4(DFN,"A02",VAFHDT,+PIVOT)
. . ;
. . I VAFHDT=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT) Q
. ;
. ;I TYPE=3 it means we're editing an existing DISCHARGE
. ;
. I (TYPE=3) D Q
. . W:$D(VATRACE) !,2.3
. . ;
. . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
. . I VAFHDT'=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . . I +PIVCHK>0 D Q
. . . . D BLDMSG^VAFCADT2(DFN,"A13",OLDDATE,"05",IEN,+PIVOT)
. . . . D BLDMSG^VAFCADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT)
. . ;
. . I VAFHDT=OLDDATE D Q
. . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . . I +PIVCHK>0 D BLDMSG^VAFCADT2(DFN,EVENT,VAFHDT,"05",IEN,+PIVOT) Q
. ;
. ;I TYPE=6 it means we're editing an existing SPECIALTY TRANSFER
. ;
. I (TYPE=6) D Q
. . W:$D(VATRACE) !,2.6
. . ;
. . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
. . ;
. . I VAFHDT'=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D Q
. . . . D DELETE^VAFCADT4(DFN,"A08",OLDDATE,+PIVOT,2.6)
. . . . D INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT)
. . ;
. . I VAFHDT=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT) Q
;
;If DGPMP'="" and DGPMA="" it means we're deleting an ADMISSION,
;TRANSFER, DISCHARGE, or SPECIALTY TRANSFER
;
I (DGPMP'="")&(DGPMA="") D G EXIT
. D SETVARS^VAFCADT4(DGPMP,DGPMDA)
. K HISTORY
. D BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
. ;
. ;If TYPE=1 it means we're deleting an ADMISSION
. ;
. I (TYPE=1) S EVENT="A11" D Q
. . W:$D(VATRACE) !,3.1
. . S PIVCHK=$$PIVCHK^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
. . ;
. . I +PIVCHK'>0 Q
. . K HL D INIT^HLFNC2("VAFC ADT-A11 SERVER",.HL) ; doit here before dgbuild
. . I $D(HL)#2 Q
. . S PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,18,44,45")
. . S PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
. . D BLDMSG^VAFCADT2(DFN,EVENT,VAFHDT,"05","",+PIVOT,PV1)
. . N GARBAGE
. . S GARBAGE=$$UPDATE^VAFHUTL(+PIVOT,"","",1)
. ;
. ;If TYPE=2 it means we're deleting a TRANSFER
. ;
. I (TYPE=2) S EVENT="A12" D Q
. . W:$D(VATRACE) !,3.2
. . ;
. . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
. . ;
. . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . ;
. . I +PIVCHK>0 D DELETE^VAFCADT4(DFN,EVENT,VAFHDT,+PIVOT,3.2) Q
. ;
. ;If TYPE=3 it means we're deleting a DISCHARGE
. ;
. I (TYPE=3) S EVENT="A13" D Q
. . W:$D(VATRACE) !,3.3
. . ;
. . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
. . ;
. . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . ;
. . I +PIVCHK>0 D BLDMSG^VAFCADT2(DFN,EVENT,VAFHDT,"05","",+PIVOT) Q
. ;
. ;If TYPE=6 it means we're deleting a SPECIALTY TRANSFER
. ;
. I (TYPE=6) S EVENT="A08" D Q
. . W:$D(VATRACE) !,3.6
. . ;
. . D PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
. . ;
. . I +PIVCHK'>0 D ENTIRE^VAFCADT4(+PIVOT) Q
. . ;
. . I +PIVCHK>0 D DELETE^VAFCADT4(DFN,EVENT,VAFHDT,+PIVOT,3.6) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCADT1 8814 printed Oct 16, 2024@19:01:59 Page 2
VAFCADT1 ;ALB/RJS - HL7 PATIENT MOVEMENT EVENTS - APRIL 13,1995 ; 7/12/04 1:49pm
+1 ;;5.3;Registration;**91,179,992**;Aug 13, 1993;Build 5
+2 ;HL7v1.6
+3 ;This Routine is executed as an item protocol on the DGPM Patient
+4 ;Movement Event Driver. It's purpose is to determine what event
+5 ;has occurred. Has an Admission been created ? Has a Transfer with
+6 ;an associated Specialty Transfer been deleted ? This routine
+7 ;contains the logic to determine this.
+8 ;
+9 ;In certain instances, one HL7 message will be sent. In other
+10 ;instances portions (or the entire) history of an admission may
+11 ;be sent.
+12 ;
+13 ;A Portion of the history will be sent, if that portion
+14 ;is affected by the insertion or deletion of an event.
+15 ;
+16 ;You can run this software in the foreground and turn on a trace of
+17 ;this software, by defining the node ^TMP("VAFCADT1",$J)
+18 ;
+19 if '$PIECE($$SEND^VAFHUTL(),"^",2)
QUIT
+20 ;S ^TMP("VAFCADT1",$J)=1
+21 NEW VATRACE,VAFH
+22 MERGE VAFH=^UTILITY("DGPM",$JOB)
+23 IF '($GET(DGQUIET))
Begin DoDot:1
+24 WRITE !,"Executing HL7 ADT Messaging"
+25 IF $DATA(^TMP("VAFCADT1",$JOB))
SET VATRACE=1
End DoDot:1
+26 ; DG*5.3*992 - Call INITIZE directly instead of queuing to avoid timing issues when reinstating orders after readmission from observation ward
+27 DO INITIZE
+28 ;I $D(VATRACE) D G EXIT
+29 ;. D INITIZE
+30 ;N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH
+31 ;S ZTDESC="HL7 ADT MESSAGE",ZTRTN="INITIZE^VAFCADT1",ZTSAVE("DGPMP")="",ZTSAVE("DGPMA")="",ZTIO="",ZTSAVE("DGPMDA")="",ZTSAVE("DFN")="",ZTDTH=$H,ZTSAVE("VAFH(")=""
+32 ;D ^%ZTLOAD
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO KILL^HLTRANS
+3 KILL ^TMP("HLS",$JOB)
+4 QUIT
+5 ;
INITIZE ;;;can't do v1.6 it here, need event for init
+1 ;S HLNDAP="PIMS HL7" D INIT^HLTRANS
+2 ;S HLNDAP="PIMS HL7" D INIT^HLFNC2("VAFH "_EVENT,.HL)
+3 ;I $D(HLERR) Q
+4 ;I $D(HL)<2 Q
+5 DO EVENT
DO EXIT
+6 QUIT
EVENT ;
+1 IF $GET(DGPMP)=""&($GET(DGPMA)="")
QUIT
+2 NEW EVENT,TYPE,VAFHDT,ADMSSN,ADMDATE,IEN,PIVOT,PIVCHK,HISTORY
+3 NEW OLDDATE,PV1,GARBAGE,MOVETYPE
+4 ;
+5 ;I DGPMP="" and DGPMA'="" it means we're adding a new ADMISSION,
+6 ;TRANSFER, DISCHARGE, or SPECIALTY TRANSFER to the Patient Movement
+7 ;File
+8 ;
+9 IF (DGPMP="")&(DGPMA'="")
Begin DoDot:1
+10 ;
+11 ; TYPE,VAFHDT,ADMSSN,IEN
DO SETVARS^VAFCADT4(DGPMA,DGPMDA)
+12 ;
+13 ;I TYPE=3 it means we're inserting a DISCHARGE
+14 ;
+15 IF (TYPE=3)
SET EVENT="A03"
Begin DoDot:2
+16 if $DATA(VATRACE)
WRITE !,1.3
+17 SET MOVETYPE=$$MOVETYPE^VAFCADT4(DGPMA)
+18 IF MOVETYPE=41
DO 41^VAFCADT5(DFN)
QUIT
+19 IF MOVETYPE=46
DO 46^VAFCADT5(DFN)
QUIT
+20 SET PIVCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(ADMSSN),1,ADMSSN_";DGPM(")
+21 SET PIVOT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFCADT4(ADMSSN),1,ADMSSN_";DGPM(")
+22 IF +PIVCHK>0
DO BLDMSG^VAFCADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT)
QUIT
+23 KILL HISTORY
+24 DO BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
+25 DO ENTIRE^VAFCADT4(+PIVOT)
End DoDot:2
QUIT
+26 ;
+27 ;I TYPE=1 it means we're inserting an ADMISSION
+28 ;
+29 IF (TYPE=1)
Begin DoDot:2
+30 if $DATA(VATRACE)
WRITE !,1.1
+31 DO PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
+32 DO BLDMSG^VAFCADT2(DFN,"A01",VAFHDT,"05",IEN,+PIVOT)
End DoDot:2
QUIT
+33 ;
+34 ;I TYPE=2 it means we're inserting a TRANSFER
+35 ;
+36 IF (TYPE=2)
Begin DoDot:2
+37 if $DATA(VATRACE)
WRITE !,1.2
+38 SET MOVETYPE=$$MOVETYPE^VAFCADT4(DGPMA)
+39 IF MOVETYPE=13
DO 13^VAFCADT5(DFN)
QUIT
+40 IF MOVETYPE=14
DO 14^VAFCADT5(DFN)
QUIT
+41 IF MOVETYPE=43
DO 43^VAFCADT5(DFN)
QUIT
+42 IF MOVETYPE=44
DO 44^VAFCADT5(DFN)
QUIT
+43 KILL HISTORY
+44 DO BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
+45 DO PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
+46 DO ADDING^VAFCADT4(DFN,"A02",VAFHDT,+PIVOT,+PIVCHK)
QUIT
End DoDot:2
QUIT
+47 ;
+48 ;I TYPE=6 it means we're inserting a standalone SPECIALTY TRANSFER
+49 ;
+50 IF (TYPE=6)
Begin DoDot:2
+51 if $DATA(VATRACE)
WRITE !,1.6
+52 KILL HISTORY
+53 DO BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
+54 DO PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
+55 DO ADDING^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT,+PIVCHK)
QUIT
End DoDot:2
QUIT
End DoDot:1
GOTO EXIT
+56 ;
+57 ;If DGPMP'="" and DGPMA'="" it means we're editing an existing
+58 ;ADMISSION, DISCHARGE, TRANSFER, or SPECIALTY TRANSFER
+59 ;
+60 IF (DGPMP'="")&(DGPMA'="")
Begin DoDot:1
+61 ;
+62 DO SETVARS^VAFCADT4(DGPMA,DGPMDA)
+63 SET EVENT="A08"
SET OLDDATE=$PIECE(DGPMP,"^",1)
+64 KILL HISTORY
+65 DO BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
+66 IF '$DATA(HISTORY)
QUIT
+67 ;
+68 ;I TYPE=1 it means we're editing an existing ADMISSION
+69 ;
+70 IF (TYPE=1)
Begin DoDot:2
+71 if $DATA(VATRACE)
WRITE !,2.1
+72 ;
+73 ;If the DATE/TIME of the admission is one of the fields
+74 ;that's been edited, it demands special treatment
+75 ;
+76 IF VAFHDT'=OLDDATE
Begin DoDot:3
+77 ; doit here before dgbuild
KILL HL
DO INIT^HLFNC2("VAFC ADT-A11 SERVER",.HL)
+78 IF $DATA(HL)#2
QUIT
+79 SET PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,18,44,45")
+80 SET PIVCHK=$$PIVCHK^VAFHPIVT(DFN,OLDDATE,1,ADMSSN_";DGPM(")
+81 ;
+82 IF +PIVCHK>0
Begin DoDot:4
+83 SET PIVOT=$$PIVNW^VAFHPIVT(DFN,OLDDATE,1,ADMSSN_";DGPM(")
+84 DO BLDMSG^VAFCADT2(DFN,"A11",OLDDATE,"05","",+PIVOT,PV1)
+85 SET GARBAGE=$$UPDATE^VAFHUTL(+PIVOT,"","",1)
End DoDot:4
+86 SET PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
+87 if +PIVOT>0
DO ENTIRE^VAFCADT4(+PIVOT)
End DoDot:3
QUIT
+88 ;
+89 IF VAFHDT=OLDDATE
Begin DoDot:3
+90 ;
+91 DO PIVINIT^VAFCADT4(DFN,VAFHDT,ADMSSN)
+92 ;
+93 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+94 ;
+95 IF +PIVCHK>0
DO INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT)
QUIT
End DoDot:3
QUIT
End DoDot:2
QUIT
+96 ;
+97 ;I TYPE=2 it means we're editing an existing TRANSFER
+98 ;
+99 IF (TYPE=2)
Begin DoDot:2
+100 if $DATA(VATRACE)
WRITE !,2.2
+101 ;
+102 DO PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
+103 ;
+104 IF VAFHDT'=OLDDATE
Begin DoDot:3
+105 ;
+106 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+107 ;
+108 IF +PIVCHK>0
Begin DoDot:4
+109 DO DELETE^VAFCADT4(DFN,"A12",OLDDATE,+PIVOT,2.2)
+110 DO INSERT^VAFCADT4(DFN,"A02",VAFHDT,+PIVOT)
End DoDot:4
QUIT
End DoDot:3
QUIT
+111 ;
+112 IF VAFHDT=OLDDATE
Begin DoDot:3
+113 ;
+114 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+115 ;
+116 IF +PIVCHK>0
DO INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT)
QUIT
End DoDot:3
QUIT
End DoDot:2
QUIT
+117 ;
+118 ;I TYPE=3 it means we're editing an existing DISCHARGE
+119 ;
+120 IF (TYPE=3)
Begin DoDot:2
+121 if $DATA(VATRACE)
WRITE !,2.3
+122 ;
+123 DO PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
+124 IF VAFHDT'=OLDDATE
Begin DoDot:3
+125 ;
+126 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+127 IF +PIVCHK>0
Begin DoDot:4
+128 DO BLDMSG^VAFCADT2(DFN,"A13",OLDDATE,"05",IEN,+PIVOT)
+129 DO BLDMSG^VAFCADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT)
End DoDot:4
QUIT
End DoDot:3
QUIT
+130 ;
+131 IF VAFHDT=OLDDATE
Begin DoDot:3
+132 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+133 IF +PIVCHK>0
DO BLDMSG^VAFCADT2(DFN,EVENT,VAFHDT,"05",IEN,+PIVOT)
QUIT
End DoDot:3
QUIT
End DoDot:2
QUIT
+134 ;
+135 ;I TYPE=6 it means we're editing an existing SPECIALTY TRANSFER
+136 ;
+137 IF (TYPE=6)
Begin DoDot:2
+138 if $DATA(VATRACE)
WRITE !,2.6
+139 ;
+140 DO PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
+141 ;
+142 IF VAFHDT'=OLDDATE
Begin DoDot:3
+143 ;
+144 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+145 ;
+146 IF +PIVCHK>0
Begin DoDot:4
+147 DO DELETE^VAFCADT4(DFN,"A08",OLDDATE,+PIVOT,2.6)
+148 DO INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT)
End DoDot:4
QUIT
End DoDot:3
QUIT
+149 ;
+150 IF VAFHDT=OLDDATE
Begin DoDot:3
+151 ;
+152 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+153 ;
+154 IF +PIVCHK>0
DO INSERT^VAFCADT4(DFN,"A08",VAFHDT,+PIVOT)
QUIT
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
GOTO EXIT
+155 ;
+156 ;If DGPMP'="" and DGPMA="" it means we're deleting an ADMISSION,
+157 ;TRANSFER, DISCHARGE, or SPECIALTY TRANSFER
+158 ;
+159 IF (DGPMP'="")&(DGPMA="")
Begin DoDot:1
+160 DO SETVARS^VAFCADT4(DGPMP,DGPMDA)
+161 KILL HISTORY
+162 DO BLDHIST^VAFCADT3(DFN,ADMSSN,"HISTORY")
+163 ;
+164 ;If TYPE=1 it means we're deleting an ADMISSION
+165 ;
+166 IF (TYPE=1)
SET EVENT="A11"
Begin DoDot:2
+167 if $DATA(VATRACE)
WRITE !,3.1
+168 SET PIVCHK=$$PIVCHK^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
+169 ;
+170 IF +PIVCHK'>0
QUIT
+171 ; doit here before dgbuild
KILL HL
DO INIT^HLFNC2("VAFC ADT-A11 SERVER",.HL)
+172 IF $DATA(HL)#2
QUIT
+173 SET PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,18,44,45")
+174 SET PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
+175 DO BLDMSG^VAFCADT2(DFN,EVENT,VAFHDT,"05","",+PIVOT,PV1)
+176 NEW GARBAGE
+177 SET GARBAGE=$$UPDATE^VAFHUTL(+PIVOT,"","",1)
End DoDot:2
QUIT
+178 ;
+179 ;If TYPE=2 it means we're deleting a TRANSFER
+180 ;
+181 IF (TYPE=2)
SET EVENT="A12"
Begin DoDot:2
+182 if $DATA(VATRACE)
WRITE !,3.2
+183 ;
+184 DO PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
+185 ;
+186 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+187 ;
+188 IF +PIVCHK>0
DO DELETE^VAFCADT4(DFN,EVENT,VAFHDT,+PIVOT,3.2)
QUIT
End DoDot:2
QUIT
+189 ;
+190 ;If TYPE=3 it means we're deleting a DISCHARGE
+191 ;
+192 IF (TYPE=3)
SET EVENT="A13"
Begin DoDot:2
+193 if $DATA(VATRACE)
WRITE !,3.3
+194 ;
+195 DO PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
+196 ;
+197 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+198 ;
+199 IF +PIVCHK>0
DO BLDMSG^VAFCADT2(DFN,EVENT,VAFHDT,"05","",+PIVOT)
QUIT
End DoDot:2
QUIT
+200 ;
+201 ;If TYPE=6 it means we're deleting a SPECIALTY TRANSFER
+202 ;
+203 IF (TYPE=6)
SET EVENT="A08"
Begin DoDot:2
+204 if $DATA(VATRACE)
WRITE !,3.6
+205 ;
+206 DO PIVINIT^VAFCADT4(DFN,$$ADMDATE^VAFCADT4(ADMSSN),ADMSSN)
+207 ;
+208 IF +PIVCHK'>0
DO ENTIRE^VAFCADT4(+PIVOT)
QUIT
+209 ;
+210 IF +PIVCHK>0
DO DELETE^VAFCADT4(DFN,EVENT,VAFHDT,+PIVOT,3.6)
QUIT
End DoDot:2
QUIT
End DoDot:1
GOTO EXIT
