VAFHCCAP ;ALB/CMM/PHH/EG/GAH OUTPATIENT CAPTURE TEST ; 10/18/06
;;5.3;Registration;**91,582,568,585,725**;Jun 06, 1996;Build 12
;
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 action
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 '$$SEND^VAFHUTL() Q
;
;S ^TMP($J,"VAFHCCAP")=""
;I $D(^TMP($J,"VAFHCCAP")) G EN ;for debug
;
;Queue to run NOW, returns control back to outpatient event driver
S ZTRTN="EN^VAFHCCAP",ZTDESC="PIMS Outpatient HL7 Capture"
S ZTSAVE("SDHDL")="",ZTSAVE("SDAMEVT")="",ZTSAVE("SDATA")=""
S 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
;Only fire if check-in,check-out, add/edit add, add/edit change
I SDAMEVT<4!(SDAMEVT>7) Q
;
;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")
;
;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 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")
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,"","",$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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHCCAP 3974 printed Oct 16, 2024@19:03:19 Page 2
VAFHCCAP ;ALB/CMM/PHH/EG/GAH OUTPATIENT CAPTURE TEST ; 10/18/06
+1 ;;5.3;Registration;**91,582,568,585,725**;Jun 06, 1996;Build 12
+2 ;
CAP ;
+1 ;Only fire if check-in,check-out, add/edit add, add/edit change
+2 IF ($GET(SDAMEVT)<4)!($GET(SDAMEVT)>7)
QUIT
+3 ;quit if no action
+4 IF +$GET(SDATA("BEFORE","STATUS"))=3
IF +$GET(SDATA("AFTER","STATUS"))=3
+5 IF $TEST
IF $PIECE($GET(SDATA("AFTER","STATUS")),"^",3)'="ACTION REQ/CHECKED IN"
+6 IF $TEST
IF $PIECE($GET(SDATA("BEFORE","STATUS")),"^",3)'="NO ACTION TAKEN/TODAY"
QUIT
+7 ;check to see if sending is on or off
+8 IF '$$SEND^VAFHUTL()
QUIT
+9 ;
+10 ;S ^TMP($J,"VAFHCCAP")=""
+11 ;I $D(^TMP($J,"VAFHCCAP")) G EN ;for debug
+12 ;
+13 ;Queue to run NOW, returns control back to outpatient event driver
+14 SET ZTRTN="EN^VAFHCCAP"
SET ZTDESC="PIMS Outpatient HL7 Capture"
+15 SET ZTSAVE("SDHDL")=""
SET ZTSAVE("SDAMEVT")=""
SET ZTSAVE("SDATA")=""
+16 SET ZTSAVE("^TMP(""SDEVT"",$J,")=""
SET ZTIO=""
SET ZTDTH=$HOROLOG
+17 DO ^%ZTLOAD
+18 ;W !?3,$G(ZTSK)
+19 QUIT
+20 ;
EN ;
+1 NEW DFN,HLD,EVDT,CHK,ERR,SEND,NEW,EVENT,HOSP,THLD,PTR,REM,HPTR
+2 ;Only fire if check-in,check-out, add/edit add, add/edit change
+3 IF SDAMEVT<4!(SDAMEVT>7)
QUIT
+4 ;
+5 ;Appointments
+6 IF SDAMEVT=4!(SDAMEVT=5)
Begin DoDot:1
+7 SET DFN=$PIECE(SDATA,"^",2)
SET EVDT=$PIECE(SDATA,"^",3)
SET PTR=$$GETPTR^VAFHCUTL(1)
SET PTR=PTR_";SCE("
SET (CHK,UP,REM)=""
+8 ;check-in or unscheduled visit check-in
IF SDAMEVT=4
SET PTR=DFN_";DPT("
+9 ;Need to check if deleting check-out
+10 ;if deleting check-out and no pivot file entry exists don't send
+11 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"
+12 ;set send to N if deleting and not in pivot file
+13 IF '$DATA(SEND)
Begin DoDot:2
+14 SET HLD=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
+15 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,"")
+16 IF +HLD=-1
SET HLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR)
+17 SET EVENT=$PIECE(HLD,":")
SET 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")
End DoDot:2
End DoDot:1
+18 ;
+19 ;Stop codes, Add/Edits
+20 IF SDAMEVT=6!(SDAMEVT=7)
Begin DoDot:1
+21 NEW HLD,STOP,THLD,REMOVE,UP
+22 SET HLD=""
SET STOP="N"
SET ERR=""
+23 FOR
KILL EVENT
SET REMOVE="N"
SET HLD=$ORDER(^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD))
if HLD=""!(STOP="Y")
QUIT
Begin DoDot:2
+24 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
+25 ;If STOP="Y" stop code was not stand alone
+26 ;If STOP="N" stop code is stand alone
+27 IF ^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"AFTER")=""
Begin DoDot:3
+28 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("
+29 SET EVENT=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
End DoDot:3
+30 IF ^TMP("SDEVT",$JOB,SDHDL,2,"SDOE",HLD,0,"AFTER")'=""
Begin DoDot:3
+31 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
+32 IF '$DATA(EVENT)
SET THLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR)
SET EVENT=$PIECE(THLD,":")
+33 IF REMOVE="Y"
SET PTR="@"
SET UP=$$UPDATE^VAFHUTL(+EVENT,EVDT,PTR,1)
+34 IF +EVENT>0
SET 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")
End DoDot:2
End DoDot:1
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,"","",$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
