Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFCCCAP

VAFCCCAP.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. CAP ;Only fire if check-in,check-out, add/edit add, add/edit change
  1. I ($G(SDAMEVT)<4)!($G(SDAMEVT)>7) Q
  1. ;quit if no change
  1. I +$G(SDATA("BEFORE","STATUS"))=3,+$G(SDATA("AFTER","STATUS"))=3
  1. IF I $P($G(SDATA("AFTER","STATUS")),"^",3)'="ACTION REQ/CHECKED IN"
  1. IF I $P($G(SDATA("BEFORE","STATUS")),"^",3)'="NO ACTION TAKEN/TODAY" Q
  1. ;check to see if sending is on or off
  1. I '$P($$SEND^VAFHUTL(),"^",2) Q
  1. ;check if protocol disabled or no clients
  1. I $$PROTOCHK("VAFC ADT-A08-SDAM SERVER") Q
  1. ;Queue to run NOW, returns control back to outpatient event driver
  1. S ZTRTN="EN^VAFCCCAP",ZTDESC="PIMS Outpatient HL7 v2.3 Capture"
  1. S ZTSAVE("SDHDL")="",ZTSAVE("SDAMEVT")="",ZTSAVE("SDATA")="",ZTSAVE("^TMP(""SDEVT"",$J,")="",ZTIO="",ZTDTH=$H
  1. D ^%ZTLOAD
  1. ;W !?3,$G(ZTSK)
  1. Q
  1. ;
  1. EN ;
  1. N DFN,HLD,EVDT,CHK,ERR,SEND,NEW,EVENT,HOSP,THLD,PTR,REM,HPTR
  1. ;
  1. ;Appointments
  1. ;
  1. I SDAMEVT=4!(SDAMEVT=5) D
  1. .S DFN=$P(SDATA,"^",2),EVDT=$P(SDATA,"^",3),PTR=$$GETPTR^VAFHCUTL(1),PTR=PTR_";SCE(",(CHK,UP,REM)=""
  1. .I SDAMEVT=4 S PTR=DFN_";DPT(" ;check-in or unscheduled visit check-in
  1. .;Need to check if deleting check-out
  1. .;if deleting check-out and no pivot file entry exists don't send
  1. .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"
  1. .;set send to N if deleting and not in pivot file
  1. .I '$D(SEND) D
  1. ..S HLD=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
  1. ..I +HLD=-1 S HPTR=DFN_";DPT(",HLD=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,HPTR) I +HLD'=-1 S UP=$$UPDATE^VAFHUTL(+HLD,EVDT,PTR,"")
  1. ..I +HLD=-1 S HLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR)
  1. ..;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")
  1. ..;set up call to vafcmsg for out-patient
  1. ..I +HLD=-1 S ERR=HLD
  1. ..S EVENT=$P(HLD,":")
  1. ..I EVENT>0 D SETUP
  1. ;
  1. ;Stop codes, Add/Edits
  1. I SDAMEVT=6!(SDAMEVT=7) D
  1. .N HLD,STOP,THLD,REMOVE,UP
  1. .S HLD="",STOP="N",ERR=""
  1. .F K EVENT S REMOVE="N",HLD=$O(^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD)) Q:HLD=""!(STOP="Y") D
  1. ..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
  1. ..;If STOP="Y" stop code was not stand alone
  1. ..;If STOP="N" stop code is stand alone
  1. ..I ^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER")="" D
  1. ...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("
  1. ...S EVENT=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
  1. ..I ^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER")'="" D
  1. ...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("
  1. ..I '$D(EVENT) S THLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR),EVENT=$P(THLD,":")
  1. ..I +$G(THLD)=-1 S ERR=THLD
  1. ..I REMOVE="Y" S PTR="@",UP=$$UPDATE^VAFHUTL(+EVENT,EVDT,PTR,1)
  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")
  1. ..;set up call to vafcmsg for out-patient
  1. ..I +EVENT>0 D SETUP
  1. ;
  1. EXIT ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I +ERR<0 D ERROR(ERR,DFN)
  1. D KILL^HLTRANS
  1. Q
  1. ;
  1. ERROR(PNUM,DFN) ;
  1. ;Error message unable to generate A08 Message
  1. N GBL S GBL="^TMP($J,""ERR"")"
  1. I +PNUM<0 S @GBL@(0)="ERROR",@GBL@(1)=$P(PNUM,"^",2)_", unable to generate A08 Message" D EBULL^VAFHUTL2(DFN,EVDT,"",$P(GBL,")")_",")
  1. Q
  1. ;
  1. UPPTR(DFN,ADATE) ;
  1. ;Have deleted checkout, update variable pointer
  1. N PTR S PTR="@"
  1. N DGARRAY,DGCOUNT,SDDATE
  1. S DGARRAY(4)=DFN,DGARRAY(1)=ADATE_";"_ADATE,DGARRAY("FLDS")=3,DGARRAY("SORT")="P"
  1. S DGCOUNT=$$SDAPI^SDAMA301(.DGARRAY)
  1. ;
  1. I DGCOUNT>0 D
  1. .S SDDATE=0
  1. .F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,SDDATE)) Q:'SDDATE D
  1. ..I SDDATE=ADATE S PTR=DFN_";DPT("
  1. I DGCOUNT'=0 K ^TMP($J,"SDAMA301")
  1. Q PTR
  1. ;
  1. SETUP ;
  1. N PIVOTPTR
  1. ;S EVENT=$P(HLD,":")
  1. S EVNTINFO="^TMP(""VAFCMSG"",""EVNTINFO"","_$J_")"
  1. K @EVNTINFO
  1. S PIVOTPTR=+$O(^VAT(391.71,"D",+EVENT,0))
  1. I ('PIVOTPTR) S ERR="-1^Unable to create entry in ADT/HL7 PIVOT FILE" Q
  1. S @EVNTINFO@("PIVOT")=PIVOTPTR
  1. S @EVNTINFO@("SERVER PROTOCOL")="VAFC ADT-A08-SDAM SERVER"
  1. S @EVNTINFO@("VAR-PTR")=PTR
  1. S @EVNTINFO@("EVENT-NUM")=EVENT
  1. S ERR=$$BCSTADT^VAFCMSG0(DFN,"A08",EVDT,EVNTINFO)
  1. K @EVNTINFO
  1. Q
  1. PROTOCHK(SPROTO) ;
  1. ; input server protocol
  1. ;output 1 if disabled or has no clients
  1. N HL
  1. D INIT^HLFNC2(SPROTO,.HL,1)
  1. K HLQ,HLECH,HLFS
  1. Q $D(HL)#2