VAFCCCAP ;ALB/CMM/PKE/PHH/EG/GAH OUTPATIENT CAPTURE TEST ; 5/5/05 9:04am
;;5.3;Registration;**91,179,553,582,568,585,662,725,744**;Jun 06, 1996;Build 5
;
;
CAP ;Only fire if check-in,check-out, add/edit add, add/edit change
I ($G(SDAMEVT)<4)!($G(SDAMEVT)>7) Q
;quit if no change
I +$G(SDATA("BEFORE","STATUS"))=3,+$G(SDATA("AFTER","STATUS"))=3
IF I $P($G(SDATA("AFTER","STATUS")),"^",3)'="ACTION REQ/CHECKED IN"
IF I $P($G(SDATA("BEFORE","STATUS")),"^",3)'="NO ACTION TAKEN/TODAY" Q
;check to see if sending is on or off
I '$P($$SEND^VAFHUTL(),"^",2) Q
;check if protocol disabled or no clients
I $$PROTOCHK("VAFC ADT-A08-SDAM SERVER") Q
;Queue to run NOW, returns control back to outpatient event driver
S ZTRTN="EN^VAFCCCAP",ZTDESC="PIMS Outpatient HL7 v2.3 Capture"
S ZTSAVE("SDHDL")="",ZTSAVE("SDAMEVT")="",ZTSAVE("SDATA")="",ZTSAVE("^TMP(""SDEVT"",$J,")="",ZTIO="",ZTDTH=$H
D ^%ZTLOAD
;W !?3,$G(ZTSK)
Q
;
EN ;
N DFN,HLD,EVDT,CHK,ERR,SEND,NEW,EVENT,HOSP,THLD,PTR,REM,HPTR
;
;Appointments
;
I SDAMEVT=4!(SDAMEVT=5) D
.S DFN=$P(SDATA,"^",2),EVDT=$P(SDATA,"^",3),PTR=$$GETPTR^VAFHCUTL(1),PTR=PTR_";SCE(",(CHK,UP,REM)=""
.I SDAMEVT=4 S PTR=DFN_";DPT(" ;check-in or unscheduled visit check-in
.;Need to check if deleting check-out
.;if deleting check-out and no pivot file entry exists don't send
.I +$G(SDATA("AFTER","STATUS"))=3&(+$G(SDATA("BEFORE","STATUS"))=2) S CHK=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR),PTR=$$UPPTR(DFN,EVDT) S:PTR="@" REM=1 S:+CHK>0 UP=$$UPDATE^VAFHUTL(+CHK,EVDT,PTR,REM) S:+CHK<0!(+UP<0) SEND="N"
.;set send to N if deleting and not in pivot file
.I '$D(SEND) D
..S HLD=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
..I +HLD=-1 S HPTR=DFN_";DPT(",HLD=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,HPTR) I +HLD'=-1 S UP=$$UPDATE^VAFHUTL(+HLD,EVDT,PTR,"")
..I +HLD=-1 S HLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR)
..;S EVENT=$P(HLD,":"),ERR=$$OA08^VAFHCA08(DFN,EVENT,EVDT,PTR,"2,3,4,5,6,7,8,9,11,12,13,14,16,19","2,3,4,5,6,7,8,9,10,11,12,13,14,15","A","A")
..;set up call to vafcmsg for out-patient
..I +HLD=-1 S ERR=HLD
..S EVENT=$P(HLD,":")
..I EVENT>0 D SETUP
;
;Stop codes, Add/Edits
I SDAMEVT=6!(SDAMEVT=7) D
.N HLD,STOP,THLD,REMOVE,UP
.S HLD="",STOP="N",ERR=""
.F K EVENT S REMOVE="N",HLD=$O(^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD)) Q:HLD=""!(STOP="Y") D
..I ^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER")'=""&($P(^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER"),"^",6)'="") S STOP="Y" Q
..;If STOP="Y" stop code was not stand alone
..;If STOP="N" stop code is stand alone
..I ^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER")="" D
...S REMOVE="Y",DFN=$P(^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"BEFORE"),"^",2),EVDT=$P(^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"BEFORE"),"^"),PTR=HLD_";SCE("
...S EVENT=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
..I ^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER")'="" D
...S DFN=$P(^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER"),"^",2),EVDT=$P(^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER"),"^"),PTR=HLD_";SCE("
..I '$D(EVENT) S THLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR),EVENT=$P(THLD,":")
..I +$G(THLD)=-1 S ERR=THLD
..I REMOVE="Y" S PTR="@",UP=$$UPDATE^VAFHUTL(+EVENT,EVDT,PTR,1)
..;I +EVENT>0 S ERR=$$OA08^VAFHCA08(DFN,EVENT,EVDT,PTR,"2,3,4,5,6,7,8,9,11,12,13,14,16,19","2,3,4,5,6,7,8,9,10,11,12,13,14,15","A","A")
..;set up call to vafcmsg for out-patient
..I +EVENT>0 D SETUP
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
I +ERR<0 D ERROR(ERR,DFN)
D KILL^HLTRANS
Q
;
ERROR(PNUM,DFN) ;
;Error message unable to generate A08 Message
N GBL S GBL="^TMP($J,""ERR"")"
I +PNUM<0 S @GBL@(0)="ERROR",@GBL@(1)=$P(PNUM,"^",2)_", unable to generate A08 Message" D EBULL^VAFHUTL2(DFN,EVDT,"",$P(GBL,")")_",")
Q
;
UPPTR(DFN,ADATE) ;
;Have deleted checkout, update variable pointer
N PTR S PTR="@"
N DGARRAY,DGCOUNT,SDDATE
S DGARRAY(4)=DFN,DGARRAY(1)=ADATE_";"_ADATE,DGARRAY("FLDS")=3,DGARRAY("SORT")="P"
S DGCOUNT=$$SDAPI^SDAMA301(.DGARRAY)
;
I DGCOUNT>0 D
.S SDDATE=0
.F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,SDDATE)) Q:'SDDATE D
..I SDDATE=ADATE S PTR=DFN_";DPT("
I DGCOUNT'=0 K ^TMP($J,"SDAMA301")
Q PTR
;
SETUP ;
N PIVOTPTR
;S EVENT=$P(HLD,":")
S EVNTINFO="^TMP(""VAFCMSG"",""EVNTINFO"","_$J_")"
K @EVNTINFO
S PIVOTPTR=+$O(^VAT(391.71,"D",+EVENT,0))
I ('PIVOTPTR) S ERR="-1^Unable to create entry in ADT/HL7 PIVOT FILE" Q
S @EVNTINFO@("PIVOT")=PIVOTPTR
S @EVNTINFO@("SERVER PROTOCOL")="VAFC ADT-A08-SDAM SERVER"
S @EVNTINFO@("VAR-PTR")=PTR
S @EVNTINFO@("EVENT-NUM")=EVENT
S ERR=$$BCSTADT^VAFCMSG0(DFN,"A08",EVDT,EVNTINFO)
K @EVNTINFO
Q
PROTOCHK(SPROTO) ;
; input server protocol
;output 1 if disabled or has no clients
N HL
D INIT^HLFNC2(SPROTO,.HL,1)
K HLQ,HLECH,HLFS
Q $D(HL)#2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCCCAP 4769 printed Apr 09, 2024@21:52:45 Page 2
VAFCCCAP ;ALB/CMM/PKE/PHH/EG/GAH OUTPATIENT CAPTURE TEST ; 5/5/05 9:04am
+1 ;;5.3;Registration;**91,179,553,582,568,585,662,725,744**;Jun 06, 1996;Build 5
+2 ;
+3 ;
CAP ;Only fire if check-in,check-out, add/edit add, add/edit change
+1 IF ($GET(SDAMEVT)<4)!($GET(SDAMEVT)>7)
QUIT
+2 ;quit if no change
+3 IF +$GET(SDATA("BEFORE","STATUS"))=3
IF +$GET(SDATA("AFTER","STATUS"))=3
+4 IF $TEST
IF $PIECE($GET(SDATA("AFTER","STATUS")),"^",3)'="ACTION REQ/CHECKED IN"
+5 IF $TEST
IF $PIECE($GET(SDATA("BEFORE","STATUS")),"^",3)'="NO ACTION TAKEN/TODAY"
QUIT
+6 ;check to see if sending is on or off
+7 IF '$PIECE($$SEND^VAFHUTL(),"^",2)
QUIT
+8 ;check if protocol disabled or no clients
+9 IF $$PROTOCHK("VAFC ADT-A08-SDAM SERVER")
QUIT
+10 ;Queue to run NOW, returns control back to outpatient event driver
+11 SET ZTRTN="EN^VAFCCCAP"
SET ZTDESC="PIMS Outpatient HL7 v2.3 Capture"
+12 SET ZTSAVE("SDHDL")=""
SET ZTSAVE("SDAMEVT")=""
SET ZTSAVE("SDATA")=""
SET ZTSAVE("^TMP(""SDEVT"",$J,")=""
SET ZTIO=""
SET ZTDTH=$HOROLOG
+13 DO ^%ZTLOAD
+14 ;W !?3,$G(ZTSK)
+15 QUIT
+16 ;
EN ;
+1 NEW DFN,HLD,EVDT,CHK,ERR,SEND,NEW,EVENT,HOSP,THLD,PTR,REM,HPTR
+2 ;
+3 ;Appointments
+4 ;
+5 IF SDAMEVT=4!(SDAMEVT=5)
Begin DoDot:1
+6 SET DFN=$PIECE(SDATA,"^",2)
SET EVDT=$PIECE(SDATA,"^",3)
SET PTR=$$GETPTR^VAFHCUTL(1)
SET PTR=PTR_";SCE("
SET (CHK,UP,REM)=""
+7 ;check-in or unscheduled visit check-in
IF SDAMEVT=4
SET PTR=DFN_";DPT("
+8 ;Need to check if deleting check-out
+9 ;if deleting check-out and no pivot file entry exists don't send
+10 IF +$GET(SDATA("AFTER","STATUS"))=3&(+$GET(SDATA("BEFORE","STATUS"))=2)
SET CHK=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
SET PTR=$$UPPTR(DFN,EVDT)
if PTR="@"
SET REM=1
if +CHK>0
SET UP=$$UPDATE^VAFHUTL(+CHK,EVDT,PTR,REM)
if +CHK<0!(+UP<0)
SET SEND="N"
+11 ;set send to N if deleting and not in pivot file
+12 IF '$DATA(SEND)
Begin DoDot:2
+13 SET HLD=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
+14 IF +HLD=-1
SET HPTR=DFN_";DPT("
SET HLD=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,HPTR)
IF +HLD'=-1
SET UP=$$UPDATE^VAFHUTL(+HLD,EVDT,PTR,"")
+15 IF +HLD=-1
SET HLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR)
+16 ;S EVENT=$P(HLD,":"),ERR=$$OA08^VAFHCA08(DFN,EVENT,EVDT,PTR,"2,3,4,5,6,7,8,9,11,12,13,14,16,19","2,3,4,5,6,7,8,9,10,11,12,13,14,15","A","A")
+17 ;set up call to vafcmsg for out-patient
+18 IF +HLD=-1
SET ERR=HLD
+19 SET EVENT=$PIECE(HLD,":")
+20 IF EVENT>0
DO SETUP
End DoDot:2
End DoDot:1
+21 ;
+22 ;Stop codes, Add/Edits
+23 IF SDAMEVT=6!(SDAMEVT=7)
Begin DoDot:1
+24 NEW HLD,STOP,THLD,REMOVE,UP
+25 SET HLD=""
SET STOP="N"
SET ERR=""
+26 FOR
KILL EVENT
SET REMOVE="N"
SET HLD=$ORDER(^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD))
if HLD=""!(STOP="Y")
QUIT
Begin DoDot:2
+27 IF ^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"AFTER")'=""&($PIECE(^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"AFTER"),"^",6)'="")
SET STOP="Y"
QUIT
+28 ;If STOP="Y" stop code was not stand alone
+29 ;If STOP="N" stop code is stand alone
+30 IF ^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"AFTER")=""
Begin DoDot:3
+31 SET REMOVE="Y"
SET DFN=$PIECE(^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"BEFORE"),"^",2)
SET EVDT=$PIECE(^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"BEFORE"),"^")
SET PTR=HLD_";SCE("
+32 SET EVENT=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
End DoDot:3
+33 IF ^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"AFTER")'=""
Begin DoDot:3
+34 SET DFN=$PIECE(^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"AFTER"),"^",2)
SET EVDT=$PIECE(^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"AFTER"),"^")
SET PTR=HLD_";SCE("
End DoDot:3
+35 IF '$DATA(EVENT)
SET THLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR)
SET EVENT=$PIECE(THLD,":")
+36 IF +$GET(THLD)=-1
SET ERR=THLD
+37 IF REMOVE="Y"
SET PTR="@"
SET UP=$$UPDATE^VAFHUTL(+EVENT,EVDT,PTR,1)
+38 ;I +EVENT>0 S ERR=$$OA08^VAFHCA08(DFN,EVENT,EVDT,PTR,"2,3,4,5,6,7,8,9,11,12,13,14,16,19","2,3,4,5,6,7,8,9,10,11,12,13,14,15","A","A")
+39 ;set up call to vafcmsg for out-patient
+40 IF +EVENT>0
DO SETUP
End DoDot:2
End DoDot:1
+41 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF +ERR<0
DO ERROR(ERR,DFN)
+3 DO KILL^HLTRANS
+4 QUIT
+5 ;
ERROR(PNUM,DFN) ;
+1 ;Error message unable to generate A08 Message
+2 NEW GBL
SET GBL="^TMP($J,""ERR"")"
+3 IF +PNUM<0
SET @GBL@(0)="ERROR"
SET @GBL@(1)=$PIECE(PNUM,"^",2)_", unable to generate A08 Message"
DO EBULL^VAFHUTL2(DFN,EVDT,"",$PIECE(GBL,")")_",")
+4 QUIT
+5 ;
UPPTR(DFN,ADATE) ;
+1 ;Have deleted checkout, update variable pointer
+2 NEW PTR
SET PTR="@"
+3 NEW DGARRAY,DGCOUNT,SDDATE
+4 SET DGARRAY(4)=DFN
SET DGARRAY(1)=ADATE_";"_ADATE
SET DGARRAY("FLDS")=3
SET DGARRAY("SORT")="P"
+5 SET DGCOUNT=$$SDAPI^SDAMA301(.DGARRAY)
+6 ;
+7 IF DGCOUNT>0
Begin DoDot:1
+8 SET SDDATE=0
+9 FOR
SET SDDATE=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDDATE))
if 'SDDATE
QUIT
Begin DoDot:2
+10 IF SDDATE=ADATE
SET PTR=DFN_";DPT("
End DoDot:2
End DoDot:1
+11 IF DGCOUNT'=0
KILL ^TMP($JOB,"SDAMA301")
+12 QUIT PTR
+13 ;
SETUP ;
+1 NEW PIVOTPTR
+2 ;S EVENT=$P(HLD,":")
+3 SET EVNTINFO="^TMP(""VAFCMSG"",""EVNTINFO"","_$JOB_")"
+4 KILL @EVNTINFO
+5 SET PIVOTPTR=+$ORDER(^VAT(391.71,"D",+EVENT,0))
+6 IF ('PIVOTPTR)
SET ERR="-1^Unable to create entry in ADT/HL7 PIVOT FILE"
QUIT
+7 SET @EVNTINFO@("PIVOT")=PIVOTPTR
+8 SET @EVNTINFO@("SERVER PROTOCOL")="VAFC ADT-A08-SDAM SERVER"
+9 SET @EVNTINFO@("VAR-PTR")=PTR
+10 SET @EVNTINFO@("EVENT-NUM")=EVENT
+11 SET ERR=$$BCSTADT^VAFCMSG0(DFN,"A08",EVDT,EVNTINFO)
+12 KILL @EVNTINFO
+13 QUIT
PROTOCHK(SPROTO) ;
+1 ; input server protocol
+2 ;output 1 if disabled or has no clients
+3 NEW HL
+4 DO INIT^HLFNC2(SPROTO,.HL,1)
+5 KILL HLQ,HLECH,HLFS
+6 QUIT $DATA(HL)#2
