- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHADT1 8549 printed Mar 13, 2025@22:07:21 Page 2
- 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