VAFHADT1 ;ALB/RJS - HL7 PATIENT MOVEMENT EVENTS - APRIL 13,1995
;;5.3;Registration;**91**;Jun 06, 1996
;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("VAFHADT1",$J)
;
Q:'$$SEND^VAFHUTL()
;S ^TMP("VAFHADT1",$J)=1
N VATRACE,VAFH
I '($G(DGQUIET)) D
. W !,"Executing HL7 ADT Messaging"
. I $D(^TMP("VAFHADT1",$J)) S VATRACE=1
;
I $G(DGPMP)="",$G(DGPMA)="" QUIT ;quit before tasking
MERGE VAFH=^UTILITY("DGPM",$J)
I $D(VATRACE) D G EXIT
. D INITIZE
N ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH
S ZTDESC="HL7 ADT MESSAGE",ZTRTN="INITIZE^VAFHADT1",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
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^VAFHADT4(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^VAFHADT4(DGPMA)
. . I MOVETYPE=41 D 41^VAFHADT5(DFN) Q
. . I MOVETYPE=46 D 46^VAFHADT5(DFN) Q
. . S PIVCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(ADMSSN),1,ADMSSN_";DGPM(")
. . S PIVOT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(ADMSSN),1,ADMSSN_";DGPM(")
. . I +PIVCHK>0 D BLDMSG^VAFHADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT) Q
. . K HISTORY
. . D BLDHIST^VAFHADT3(DFN,ADMSSN,"HISTORY")
. . D ENTIRE^VAFHADT4(+PIVOT)
. ;
. ;I TYPE=1 it means we're inserting an ADMISSION
. ;
. I (TYPE=1) D Q
. . W:$D(VATRACE) !,1.1
. . D PIVINIT^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
. . D BLDMSG^VAFHADT2(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^VAFHADT4(DGPMA)
. . I MOVETYPE=13 D 13^VAFHADT5(DFN) Q
. . I MOVETYPE=14 D 14^VAFHADT5(DFN) Q
. . I MOVETYPE=43 D 43^VAFHADT5(DFN) Q
. . I MOVETYPE=44 D 44^VAFHADT5(DFN) Q
. . K HISTORY
. . D BLDHIST^VAFHADT3(DFN,ADMSSN,"HISTORY")
. . D PIVINIT^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
. . D ADDING^VAFHADT4(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^VAFHADT3(DFN,ADMSSN,"HISTORY")
. . D PIVINIT^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
. . D ADDING^VAFHADT4(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^VAFHADT4(DGPMA,DGPMDA)
. S EVENT="A08",OLDDATE=$P(DGPMP,"^",1)
. K HISTORY
. D BLDHIST^VAFHADT3(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("VAFH A11",.HL) ; doit here before dgbuild
. . . I $D(HL)=1 Q
. . . S PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,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^VAFHADT2(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^VAFHADT4(+PIVOT)
. . ;
. . I VAFHDT=OLDDATE D Q
. . . ;
. . . D PIVINIT^VAFHADT4(DFN,VAFHDT,ADMSSN)
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D INSERT^VAFHADT4(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^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
. . ;
. . I VAFHDT'=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D Q
. . . . D DELETE^VAFHADT4(DFN,"A12",OLDDATE,+PIVOT,2.2)
. . . . D INSERT^VAFHADT4(DFN,"A02",VAFHDT,+PIVOT)
. . ;
. . I VAFHDT=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D INSERT^VAFHADT4(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^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
. . ;
. . I VAFHDT'=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D Q
. . . . D BLDMSG^VAFHADT2(DFN,"A13",OLDDATE,"05",IEN,+PIVOT)
. . . . D BLDMSG^VAFHADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT)
. . ;
. . I VAFHDT=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D BLDMSG^VAFHADT2(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^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
. . ;
. . I VAFHDT'=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D Q
. . . . D DELETE^VAFHADT4(DFN,"A08",OLDDATE,+PIVOT,2.6)
. . . . D INSERT^VAFHADT4(DFN,"A08",VAFHDT,+PIVOT)
. . ;
. . I VAFHDT=OLDDATE D Q
. . . ;
. . . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . . ;
. . . I +PIVCHK>0 D INSERT^VAFHADT4(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^VAFHADT4(DGPMP,DGPMDA)
. K HISTORY
. D BLDHIST^VAFHADT3(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("VAFH A11",.HL) ; doit here before dgbuild
. . I $D(HL)=1 Q
. . S PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,44,45")
. . S PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
. . D BLDMSG^VAFHADT2(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^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
. . ;
. . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . ;
. . I +PIVCHK>0 D DELETE^VAFHADT4(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^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
. . ;
. . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . ;
. . I +PIVCHK>0 D BLDMSG^VAFHADT2(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^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
. . ;
. . I +PIVCHK'>0 D ENTIRE^VAFHADT4(+PIVOT) Q
. . ;
. . I +PIVCHK>0 D DELETE^VAFHADT4(DFN,EVENT,VAFHDT,+PIVOT,3.6) Q
VAFHADT1 ;ALB/RJS - HL7 PATIENT MOVEMENT EVENTS - APRIL 13,1995
+1 ;;5.3;Registration;**91**;Jun 06, 1996
+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("VAFHADT1",$J)
+18 ;
+19 IF '$$SEND^VAFHUTL()
QUIT
+20 ;S ^TMP("VAFHADT1",$J)=1
+21 NEW VATRACE,VAFH
+22 IF '($GET(DGQUIET))
Begin DoDot:1
+23 WRITE !,"Executing HL7 ADT Messaging"
+24 IF $DATA(^TMP("VAFHADT1",$JOB))
SET VATRACE=1
End DoDot:1
+25 ;
+26 ;quit before tasking
IF $GET(DGPMP)=""
IF $GET(DGPMA)=""
QUIT
+27 MERGE VAFH=^UTILITY("DGPM",$JOB)
+28 IF $DATA(VATRACE)
Begin DoDot:1
+29 DO INITIZE
End DoDot:1
GOTO EXIT
+30 NEW ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH
+31 SET ZTDESC="HL7 ADT MESSAGE"
SET ZTRTN="INITIZE^VAFHADT1"
SET ZTSAVE("DGPMP")=""
SET ZTSAVE("DGPMA")=""
SET ZTIO=""
SET ZTSAVE("DGPMDA")=""
SET ZTSAVE("DFN")=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("VAFH(")=""
+32 DO ^%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 DO EVENT
DO EXIT
+2 QUIT
EVENT ;
+1 ;I $G(DGPMP)=""&($G(DGPMA)="") Q
+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^VAFHADT4(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^VAFHADT4(DGPMA)
+18 IF MOVETYPE=41
DO 41^VAFHADT5(DFN)
QUIT
+19 IF MOVETYPE=46
DO 46^VAFHADT5(DFN)
QUIT
+20 SET PIVCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(ADMSSN),1,ADMSSN_";DGPM(")
+21 SET PIVOT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(ADMSSN),1,ADMSSN_";DGPM(")
+22 IF +PIVCHK>0
DO BLDMSG^VAFHADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT)
QUIT
+23 KILL HISTORY
+24 DO BLDHIST^VAFHADT3(DFN,ADMSSN,"HISTORY")
+25 DO ENTIRE^VAFHADT4(+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^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
+32 DO BLDMSG^VAFHADT2(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^VAFHADT4(DGPMA)
+39 IF MOVETYPE=13
DO 13^VAFHADT5(DFN)
QUIT
+40 IF MOVETYPE=14
DO 14^VAFHADT5(DFN)
QUIT
+41 IF MOVETYPE=43
DO 43^VAFHADT5(DFN)
QUIT
+42 IF MOVETYPE=44
DO 44^VAFHADT5(DFN)
QUIT
+43 KILL HISTORY
+44 DO BLDHIST^VAFHADT3(DFN,ADMSSN,"HISTORY")
+45 DO PIVINIT^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
+46 DO ADDING^VAFHADT4(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^VAFHADT3(DFN,ADMSSN,"HISTORY")
+54 DO PIVINIT^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
+55 DO ADDING^VAFHADT4(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^VAFHADT4(DGPMA,DGPMDA)
+63 SET EVENT="A08"
SET OLDDATE=$PIECE(DGPMP,"^",1)
+64 KILL HISTORY
+65 DO BLDHIST^VAFHADT3(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("VAFH A11",.HL)
+78 IF $DATA(HL)=1
QUIT
+79 SET PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,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^VAFHADT2(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^VAFHADT4(+PIVOT)
End DoDot:3
QUIT
+88 ;
+89 IF VAFHDT=OLDDATE
Begin DoDot:3
+90 ;
+91 DO PIVINIT^VAFHADT4(DFN,VAFHDT,ADMSSN)
+92 ;
+93 IF +PIVCHK'>0
DO ENTIRE^VAFHADT4(+PIVOT)
QUIT
+94 ;
+95 IF +PIVCHK>0
DO INSERT^VAFHADT4(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^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
+103 ;
+104 IF VAFHDT'=OLDDATE
Begin DoDot:3
+105 ;
+106 IF +PIVCHK'>0
DO ENTIRE^VAFHADT4(+PIVOT)
QUIT
+107 ;
+108 IF +PIVCHK>0
Begin DoDot:4
+109 DO DELETE^VAFHADT4(DFN,"A12",OLDDATE,+PIVOT,2.2)
+110 DO INSERT^VAFHADT4(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^VAFHADT4(+PIVOT)
QUIT
+115 ;
+116 IF +PIVCHK>0
DO INSERT^VAFHADT4(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^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
+124 ;
+125 IF VAFHDT'=OLDDATE
Begin DoDot:3
+126 ;
+127 IF +PIVCHK'>0
DO ENTIRE^VAFHADT4(+PIVOT)
QUIT
+128 ;
+129 IF +PIVCHK>0
Begin DoDot:4
+130 DO BLDMSG^VAFHADT2(DFN,"A13",OLDDATE,"05",IEN,+PIVOT)
+131 DO BLDMSG^VAFHADT2(DFN,"A03",VAFHDT,"05",IEN,+PIVOT)
End DoDot:4
QUIT
End DoDot:3
QUIT
+132 ;
+133 IF VAFHDT=OLDDATE
Begin DoDot:3
+134 ;
+135 IF +PIVCHK'>0
DO ENTIRE^VAFHADT4(+PIVOT)
QUIT
+136 ;
+137 IF +PIVCHK>0
DO BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"05",IEN,+PIVOT)
QUIT
End DoDot:3
QUIT
End DoDot:2
QUIT
+138 ;
+139 ;I TYPE=6 it means we're editing an existing SPECIALTY TRANSFER
+140 ;
+141 IF (TYPE=6)
Begin DoDot:2
+142 IF $DATA(VATRACE)
WRITE !,2.6
+143 ;
+144 DO PIVINIT^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
+145 ;
+146 IF VAFHDT'=OLDDATE
Begin DoDot:3
+147 ;
+148 IF +PIVCHK'>0
DO ENTIRE^VAFHADT4(+PIVOT)
QUIT
+149 ;
+150 IF +PIVCHK>0
Begin DoDot:4
+151 DO DELETE^VAFHADT4(DFN,"A08",OLDDATE,+PIVOT,2.6)
+152 DO INSERT^VAFHADT4(DFN,"A08",VAFHDT,+PIVOT)
End DoDot:4
QUIT
End DoDot:3
QUIT
+153 ;
+154 IF VAFHDT=OLDDATE
Begin DoDot:3
+155 ;
+156 IF +PIVCHK'>0
DO ENTIRE^VAFHADT4(+PIVOT)
QUIT
+157 ;
+158 IF +PIVCHK>0
DO INSERT^VAFHADT4(DFN,"A08",VAFHDT,+PIVOT)
QUIT
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
GOTO EXIT
+159 ;
+160 ;If DGPMP'="" and DGPMA="" it means we're deleting an ADMISSION,
+161 ;TRANSFER, DISCHARGE, or SPECIALTY TRANSFER
+162 ;
+163 IF (DGPMP'="")&(DGPMA="")
Begin DoDot:1
+164 DO SETVARS^VAFHADT4(DGPMP,DGPMDA)
+165 KILL HISTORY
+166 DO BLDHIST^VAFHADT3(DFN,ADMSSN,"HISTORY")
+167 ;
+168 ;If TYPE=1 it means we're deleting an ADMISSION
+169 ;
+170 IF (TYPE=1)
SET EVENT="A11"
Begin DoDot:2
+171 IF $DATA(VATRACE)
WRITE !,3.1
+172 SET PIVCHK=$$PIVCHK^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
+173 ;
+174 IF +PIVCHK'>0
QUIT
+175 ; doit here before dgbuild
KILL HL
DO INIT^HLFNC2("VAFH A11",.HL)
+176 IF $DATA(HL)=1
QUIT
+177 SET PV1=$$DGBUILD^VAFHAPV1(DGPMP,",3,7,10,44,45")
+178 SET PIVOT=$$PIVNW^VAFHPIVT(DFN,VAFHDT,1,ADMSSN_";DGPM(")
+179 DO BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"05","",+PIVOT,PV1)
+180 NEW GARBAGE
+181 SET GARBAGE=$$UPDATE^VAFHUTL(+PIVOT,"","",1)
End DoDot:2
QUIT
+182 ;
+183 ;If TYPE=2 it means we're deleting a TRANSFER
+184 ;
+185 IF (TYPE=2)
SET EVENT="A12"
Begin DoDot:2
+186 IF $DATA(VATRACE)
WRITE !,3.2
+187 ;
+188 DO PIVINIT^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
+189 ;
+190 IF +PIVCHK'>0
DO ENTIRE^VAFHADT4(+PIVOT)
QUIT
+191 ;
+192 IF +PIVCHK>0
DO DELETE^VAFHADT4(DFN,EVENT,VAFHDT,+PIVOT,3.2)
QUIT
End DoDot:2
QUIT
+193 ;
+194 ;If TYPE=3 it means we're deleting a DISCHARGE
+195 ;
+196 IF (TYPE=3)
SET EVENT="A13"
Begin DoDot:2
+197 IF $DATA(VATRACE)
WRITE !,3.3
+198 ;
+199 DO PIVINIT^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
+200 ;
+201 IF +PIVCHK'>0
DO ENTIRE^VAFHADT4(+PIVOT)
QUIT
+202 ;
+203 IF +PIVCHK>0
DO BLDMSG^VAFHADT2(DFN,EVENT,VAFHDT,"05","",+PIVOT)
QUIT
End DoDot:2
QUIT
+204 ;
+205 ;If TYPE=6 it means we're deleting a SPECIALTY TRANSFER
+206 ;
+207 IF (TYPE=6)
SET EVENT="A08"
Begin DoDot:2
+208 IF $DATA(VATRACE)
WRITE !,3.6
+209 ;
+210 DO PIVINIT^VAFHADT4(DFN,$$ADMDATE^VAFHADT4(ADMSSN),ADMSSN)
+211 ;
+212 IF +PIVCHK'>0
DO ENTIRE^VAFHADT4(+PIVOT)
QUIT
+213 ;
+214 IF +PIVCHK>0
DO DELETE^VAFHADT4(DFN,EVENT,VAFHDT,+PIVOT,3.6)
QUIT
End DoDot:2
QUIT
End DoDot:1
GOTO EXIT