source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHCCAP.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1VAFHCCAP ;ALB/CMM/PHH/EG/GAH OUTPATIENT CAPTURE TEST ; 10/18/06
2 ;;5.3;Registration;**91,582,568,585,725**;Jun 06, 1996;Build 12
3 ;
4CAP ;
5 ;Only fire if check-in,check-out, add/edit add, add/edit change
6 I ($G(SDAMEVT)<4)!($G(SDAMEVT)>7) Q
7 ;quit if no action
8 I +$G(SDATA("BEFORE","STATUS"))=3,+$G(SDATA("AFTER","STATUS"))=3
9 IF I $P($G(SDATA("AFTER","STATUS")),"^",3)'="ACTION REQ/CHECKED IN"
10 IF I $P($G(SDATA("BEFORE","STATUS")),"^",3)'="NO ACTION TAKEN/TODAY" Q
11 ;check to see if sending is on or off
12 I '$$SEND^VAFHUTL() Q
13 ;
14 ;S ^TMP($J,"VAFHCCAP")=""
15 ;I $D(^TMP($J,"VAFHCCAP")) G EN ;for debug
16 ;
17 ;Queue to run NOW, returns control back to outpatient event driver
18 S ZTRTN="EN^VAFHCCAP",ZTDESC="PIMS Outpatient HL7 Capture"
19 S ZTSAVE("SDHDL")="",ZTSAVE("SDAMEVT")="",ZTSAVE("SDATA")=""
20 S ZTSAVE("^TMP(""SDEVT"",$J,")="",ZTIO="",ZTDTH=$H
21 D ^%ZTLOAD
22 ;W !?3,$G(ZTSK)
23 Q
24 ;
25EN ;
26 N DFN,HLD,EVDT,CHK,ERR,SEND,NEW,EVENT,HOSP,THLD,PTR,REM,HPTR
27 ;Only fire if check-in,check-out, add/edit add, add/edit change
28 I SDAMEVT<4!(SDAMEVT>7) Q
29 ;
30 ;Appointments
31 I SDAMEVT=4!(SDAMEVT=5) D
32 .S DFN=$P(SDATA,"^",2),EVDT=$P(SDATA,"^",3),PTR=$$GETPTR^VAFHCUTL(1),PTR=PTR_";SCE(",(CHK,UP,REM)=""
33 .I SDAMEVT=4 S PTR=DFN_";DPT(" ;check-in or unscheduled visit check-in
34 .;Need to check if deleting check-out
35 .;if deleting check-out and no pivot file entry exists don't send
36 .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"
37 .;set send to N if deleting and not in pivot file
38 .I '$D(SEND) D
39 ..S HLD=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
40 ..I +HLD=-1 S HPTR=DFN_";DPT(",HLD=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,HPTR) I +HLD'=-1 S UP=$$UPDATE^VAFHUTL(+HLD,EVDT,PTR,"")
41 ..I +HLD=-1 S HLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR)
42 ..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")
43 ;
44 ;Stop codes, Add/Edits
45 I SDAMEVT=6!(SDAMEVT=7) D
46 .N HLD,STOP,THLD,REMOVE,UP
47 .S HLD="",STOP="N",ERR=""
48 .F K EVENT S REMOVE="N",HLD=$O(^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD)) Q:HLD=""!(STOP="Y") D
49 ..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
50 ..;If STOP="Y" stop code was not stand alone
51 ..;If STOP="N" stop code is stand alone
52 ..I ^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER")="" D
53 ...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("
54 ...S EVENT=$$PIVCHK^VAFHPIVT(DFN,EVDT,2,PTR)
55 ..I ^TMP("SDEVT",$J,SDHDL,2,"SDOE",HLD,0,"AFTER")'="" D
56 ...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("
57 ..I '$D(EVENT) S THLD=$$PIVNW^VAFHPIVT(DFN,EVDT,2,PTR),EVENT=$P(THLD,":")
58 ..I REMOVE="Y" S PTR="@",UP=$$UPDATE^VAFHUTL(+EVENT,EVDT,PTR,1)
59 ..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")
60EXIT ;
61 I $D(ZTQUEUED) S ZTREQ="@"
62 I +ERR<0 D ERROR(ERR,DFN)
63 D KILL^HLTRANS
64 Q
65 ;
66ERROR(PNUM,DFN) ;
67 ;Error message unable to generate A08 Message
68 N GBL S GBL="^TMP($J,""ERR"")"
69 I +PNUM<0 S @GBL@(0)="ERROR",@GBL@(1)=$P(PNUM,"^",2)_", unable to generate A08 Message" D EBULL^VAFHUTL2(DFN,"","",$P(GBL,")")_",")
70 Q
71 ;
72UPPTR(DFN,ADATE) ;
73 ;Have deleted checkout, update variable pointer
74 N PTR S PTR="@"
75 N DGARRAY,DGCOUNT,SDDATE
76 S DGARRAY(4)=DFN,DGARRAY(1)=ADATE_";"_ADATE,DGARRAY("FLDS")=3,DGARRAY("SORT")="P"
77 S DGCOUNT=$$SDAPI^SDAMA301(.DGARRAY)
78 ;
79 I DGCOUNT>0 D
80 .S SDDATE=0
81 .F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,SDDATE)) Q:'SDDATE D
82 ..I SDDATE=ADATE S PTR=DFN_";DPT("
83 I DGCOUNT'=0 K ^TMP($J,"SDAMA301")
84 Q PTR
Note: See TracBrowser for help on using the repository browser.