source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRKR4.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1IBTRKR4 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK OUTPATIENT ENCOUNTERS ; 13-AUG-93
2 ;;2.0;INTEGRATED BILLING;**91,142,292,312**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ; -- entry point for nightly background job
6 N IBTSBDT,IBTSEDT
7 S IBTSBDT=$$FMADD^XLFDT(DT,$S($E(DT,6,7)=10:-730,1:-20))-.1
8 S IBTSEDT=$$FMADD^XLFDT(DT,-2)-.9
9 D EN1
10 Q
11 ;
12EN ; -- entry point to ask date range
13 N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
14 N IBBDT,IBEDT,IBTSBDT,IBTSEDT,IBTALK
15 S IBTALK=1
16 I '$P($G(^IBE(350.9,1,6)),"^",3) W !!,"I'm sorry, Tracking of Outpatient Encounters is currrently turned off." G ENQ
17 W !!!,"Select the Date Range of Opt. Encounters to Add to Claims Tracking.",!
18 D DATE^IBOUTL
19 I IBBDT<1!(IBEDT<1) G ENQ
20 S IBTSBDT=IBBDT,IBTSEDT=IBEDT
21 ; Do NOT PROCESS on VistA if Start or End>=Switch Eff Dt ;CCR-930
22 ; -- check selected dates ;IB*2.0*312
23 I +IBSWINFO,((IBTSBDT+1)>$P(IBSWINFO,"^",2))!((IBTSEDT+1)>$P(IBSWINFO,"^",2)) D G EN
24 .W !!,"The Begin OR End Date CANNOT be on or after"
25 .W !,"the PFSS Effective Date: ",$$FMTE^XLFDT($P(IBSWINFO,"^",2))
26 ;
27 S IBTRKR=$G(^IBE(350.9,1,6))
28 ; start date can't be before parameters
29 I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR W !!,"Begin date is before Claims Tracking Start Date, changed to ",$$DAT1^IBOUTL(IBTSBDT)
30 ; -- end date into future
31 I IBTSEDT>$$FMADD^XLFDT(DT,-1) W !!,"I'll automatically change the end date to 1 day prior to the date queued to run."
32 W !!!,"I'm going to automatically queue this off and send you a"
33 W !,"mail message when complete.",!
34 S ZTIO="",ZTRTN="EN1^IBTRKR4",ZTSAVE("IB*")="",ZTDESC="IB - Add Opt Encounters to Claims Tracking"
35 D ^%ZTLOAD I $G(ZTSK) K ZTSK W !,"Request Queued"
36ENQ K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
37 D HOME^%ZIS
38 Q
39 ;
40EN1 ; -- add outpatient encounters to claims tracking file
41 N I,J,X,Y,IBTRKR,IBDT,DFN,IBOETA,IBCNT,IBCNT1,IBCNT2
42 ;
43 ; -- check parameters
44 S IBTRKR=$G(^IBE(350.9,1,6))
45 G:'$P(IBTRKR,"^",3) EN1Q ; quit if opt tracking off
46 I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR ; start date can't be before parameters
47 ;
48 ; -- users can queue into future, make sure dates not after date run
49 ;I IBTSEDT>DT S IBTSEDT=DT
50 I IBTSEDT>$$FMADD^XLFDT(DT,-1) S IBMESS="(Selected end date of "_$$DAT1^IBOUTL(IBTSEDT)_" automatically changed to "_$$DAT1^IBOUTL($$FMADD^XLFDT(DT,-1))_".)",IBTSEDT=$$FMADD^XLFDT(DT,-1)
51 ;
52 S IBOETYP=$O(^IBE(356.6,"AC",2,0)) ;event type pointer for opt encounters
53 ;
54 ; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending
55 S (IBCNT,IBCNT1,IBCNT2)=0
56 ;
57 N IBVAL,IBCBK,IBFILTER
58 S IBVAL("BDT")=IBTSBDT,IBVAL("EDT")=IBTSEDT+.9
59 ; Only parent encounters, status is checked out, check out date exists,
60 ; not already in CT, not already an entry for the same encounter
61 S IBFILTER=""
62 ;S IBCBK="S IBCNT=IBCNT+1 I '$P(Y0,U,6),$P(Y0,U,12)=2,$P(Y0,U,7),'$O(^IBT(356,""AENC"",+$P(Y0,U,2),Y,0)),'$O(^IBT(356,""APTY"",+$P(Y0,U,2),IBOETYP,+Y0,0)) S IBDT=+Y0,IBOE=Y D OPCHK^IBTRKR41"
63 S IBCBK="S IBCNT=IBCNT+1 I '$P(Y0,U,6),$P(Y0,U,12)=2,$P(Y0,U,7),'$O(^IBT(356,""AENC"",+$P(Y0,U,2),Y,0)),$S($D(^IBE(356.6,""ACODE"",2,IBOETYP)):1,1:'$O(^IBT(356,""APTY"",+$P(Y0,U,2),IBOETYP,+Y0,0))) S IBDT=+Y0,IBOE=Y D OPCHK^IBTRKR41"
64 D SCAN^IBSDU("DATE/TIME",.IBVAL,IBFILTER,IBCBK,1) ;Scan,then close query
65 ;
66 I $G(IBTALK) D BULL^IBTRKR41
67EN1Q I $D(ZTQUEUED) S ZTREQ="@"
68 Q
Note: See TracBrowser for help on using the repository browser.