source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEDC.m@ 1553

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1IBCEDC ;ALB/ESG - EDI CLAIM STATUS REPORT COMPILE ;13-DEC-2007
2 ;;2.0;INTEGRATED BILLING;**377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7EN ; Compile entry point - Queued Job Entry Point
8 NEW BCHIEN,COUNT,DT1,DT2,IBIFN,IBLTRDT,IEN
9 K ^TMP($J,"IBCEDC")
10 I '$D(ZTQUEUED) W !!,"Compiling EDI Claim Status Report. Please wait "
11 ;
12 I IBMETHOD="C" G EN1 ; specific claims selected
13 ;
14 ; get dates and loop thru ALT area
15 S DT1=$G(^TMP($J,"IBCEDS","ALTDT"))
16 S DT2=$P(DT1,U,2),DT1=$P(DT1,U,1)
17 S IBLTRDT=$O(^IBA(364.1,"ALT",DT1),-1) ; get starting point
18 F S IBLTRDT=$O(^IBA(364.1,"ALT",IBLTRDT)) Q:'IBLTRDT!(IBLTRDT\1>DT2)!$G(ZTSTOP) D
19 . S BCHIEN=0
20 . F S BCHIEN=$O(^IBA(364.1,"ALT",IBLTRDT,BCHIEN)) Q:'BCHIEN!$G(ZTSTOP) D
21 .. S IEN=0
22 .. F S IEN=$O(^IBA(364,"C",BCHIEN,IEN)) Q:'IEN!$G(ZTSTOP) D COMPILE(IEN)
23 .. Q
24 . Q
25 G RPT
26 ;
27 ;
28EN1 ; specific claims selected so loop thru all EDI claims in file 364
29 ; for these claims
30 ;
31 S IBIFN=0
32 F S IBIFN=$O(^TMP($J,"IBCEDS","CLAIM",IBIFN)) Q:'IBIFN!$G(ZTSTOP) D
33 . S IEN=0
34 . F S IEN=$O(^IBA(364,"B",IBIFN,IEN)) Q:'IEN!$G(ZTSTOP) D
35 .. S BCHIEN=+$P($G(^IBA(364,IEN,0)),U,2) ; batch ien
36 .. S IBLTRDT=$P($G(^IBA(364.1,BCHIEN,1)),U,3) ; date/time last transmitted
37 .. D COMPILE(IEN)
38 .. Q
39 . Q
40 G RPT
41 ;
42 ;
43RPT ; print the report and close things down
44 D PRINT^IBCEDP ; print report
45 D ^%ZISC ; close the device
46 K ^TMP($J,"IBCEDS"),^TMP($J,"IBCEDC") ; clean up scratch globals
47 I $D(ZTQUEUED) S ZTREQ="@" ; purge the task record
48 ;
49EX ; routine exit point
50 ;
51 Q
52 ;
53COMPILE(IEN) ; gather and compile EDI claim data for one EDI claim
54 ; IEN - 364 ien
55 NEW AR,DIV,IB0,IBAGE,IBAGEDT,IBARSTAT,IBCURBAL,IBDIV,IBDIVID,IBEDIST
56 NEW IBEXTCLM,IBIFN,IBPAY,IBS,IBSGD,IBSTAT,IBZ,INS,STAT,SV1,SV2,SV3
57 S COUNT=$G(COUNT)+1
58 I COUNT#1000=0 D I $G(ZTSTOP) G COMPX
59 . I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 Q ; check for TM stop request
60 . I '$D(ZTQUEUED) W "." ; display progress indicator
61 . Q
62 S IBZ=$G(^IBA(364,IEN,0)) I IBZ="" G COMPX
63 S IBIFN=+IBZ
64 S IB0=$G(^DGCR(399,IBIFN,0)) I IB0="" G COMPX
65 S DIV=+$P(IB0,U,22) ; division ien
66 S INS=+$$FINDINS^IBCEF1(IBIFN,$P(IBZ,U,8)) ; insurance company ien for this EDI transmission
67 S STAT=$P(IBZ,U,3) ; edi status code
68 S AR=$P($$BILL^RCJIBFN2(IBIFN),U,2) ; current AR status ien
69 S IBARSTAT=$P($G(^PRCA(430.3,AR,0)),U,2) ; current AR status abbr/sort value
70 ;
71 I IBMETHOD="R",'$$CHECK(IB0,DIV,INS,STAT,IBARSTAT) G COMPX ; failed selection criteria checks
72 ;
73 S IBPAY=$P($G(^DIC(36,INS,0)),U,1)_U_INS ; payer name^insurance company ien
74 S IBDIVID=$P($G(^DG(40.8,DIV,0)),U,2) ; division id#
75 S IBDIV=IBDIVID ; division sort value
76 S IBEXTCLM=$P(IB0,U,1) ; claim#
77 S IBEDIST=STAT ; edi status sort value
78 S IBCURBAL=$G(^DGCR(399,IBIFN,"U1"))
79 S IBCURBAL=$P(IBCURBAL,U,1)-$P(IBCURBAL,U,2) ; current balance (total charges - offset)
80 ;
81 ; calculate age
82 S IBS=$G(^DGCR(399,IBIFN,"S"))
83 ; if the payer is Medicare and an MRA request date exists then use that date
84 I $$MCRWNR^IBEFUNC(INS),$P(IBS,U,7) S IBAGEDT=$P(IBS,U,7)
85 E S IBAGEDT=$P(IBS,U,10) ; otherwise use the Authorization Date
86 I 'IBAGEDT S IBAGEDT=$P(IBS,U,1) ; if error, use date entered
87 I 'IBAGEDT S IBAGEDT=$P($G(^DGCR(399,IBIFN,"U")),U,1) ; if error again, use from date on claim
88 S IBAGE=$$FMDIFF^XLFDT(DT,IBAGEDT)
89 ;
90 ; capture IB status abbr
91 S IBSTAT=$P(IB0,U,13)
92 S IBSTAT=$S(IBSTAT=2:"REQ MRA",IBSTAT=4:"PRNT/TX",IBSTAT=7:"CANCEL",1:$$EXTERNAL^DILFD(399,.13,,IBSTAT))
93 ;
94 ; Build the scratch global
95 S IBSGD=IBEXTCLM_U_$$FT^IBCEF(IBIFN)_U_$$INPAT^IBCEF(IBIFN)_U_$P(IBZ,U,8)_U_STAT_U_IBLTRDT_U_IBAGE_U_+$P(IBZ,U,2)
96 S IBSGD=IBSGD_U_IBCURBAL_U_DIV_U_IBARSTAT_U_INS_U_IBSTAT
97 S SV1=$$SV^IBCEDS1($G(IBSORT1),IEN)
98 S SV2=$$SV^IBCEDS1($G(IBSORT2),IEN)
99 S SV3=$$SV^IBCEDS1($G(IBSORT3),IEN)
100 S ^TMP($J,"IBCEDC",SV1,SV2,SV3,IEN)=IBSGD
101 ;
102COMPX ;
103 Q
104 ;
105CHECK(IB0,DIV,INS,STAT,IBARSTAT) ; check to see if EDI claim passes the selection criteria
106 ; function value =1 if passed checks
107 ; function value =0 if failed checks
108 NEW OK,EDI,PROFID,INSTID S OK=0
109 I STAT="" S STAT="~~~~"
110 I $D(^TMP($J,"IBCEDS","DIV")),'$D(^TMP($J,"IBCEDS","DIV",DIV)) S OK=0 G CHECKX ; division check
111 I $D(^TMP($J,"IBCEDS","EDI")),'$D(^TMP($J,"IBCEDS","EDI",STAT)) S OK=0 G CHECKX ; EDI status check
112 ;
113 ; IB cancelled claim check
114 I $P(IB0,U,13)=7,'$G(^TMP($J,"IBCEDS","CANCEL")) S OK=0 G CHECKX
115 ;
116 ; AR cancelled claim check
117 I $F(".CB.CN.","."_IBARSTAT_"."),'$G(^TMP($J,"IBCEDS","CANCEL")) S OK=0 G CHECKX
118 ;
119 ; payer check
120 I $D(^TMP($J,"IBCEDS","INS")) D I 'OK G CHECKX
121 . S OK=0
122 . I 'INS Q ; don't include if the payer isn't valid
123 . I $D(^TMP($J,"IBCEDS","INS",1,INS)) S OK=1 Q
124 . I '$D(^TMP($J,"IBCEDS","INS",2)) Q
125 . S EDI=$$UP^XLFSTR($G(^DIC(36,INS,3)))
126 . S PROFID=$P(EDI,U,2),INSTID=$P(EDI,U,4)
127 . I PROFID'="",$D(^TMP($J,"IBCEDS","INS",2,PROFID)) S OK=1 Q
128 . I INSTID'="",$D(^TMP($J,"IBCEDS","INS",2,INSTID)) S OK=1 Q
129 . Q
130 ;
131 ; all checks passed OK
132 S OK=1
133 ;
134CHECKX ;
135 Q OK
136 ;
Note: See TracBrowser for help on using the repository browser.