- 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 Jan 18, 2025@04:02:08 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