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

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1IBCEMQA ;DAOU/ESG - MRA QUIET BILL AUTHORIZATION ;25-MAR-2003
2 ;;2.0;INTEGRATED BILLING;**155**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q ; must be called at proper entry point
6 ;
7 ;
8AUTOCOB(IBIFN,IBEOB,ERRMSG) ; This procedure mimics and automates the
9 ; Process COB action on the MRA management screen. This is intended
10 ; to be called in background mode (no user interface).
11 ;
12 ; Input
13 ; IBIFN - bill#
14 ; IBEOB - ien of entry in file 361.1 (MRA)
15 ;
16 ; Output
17 ; ERRMSG - optional output parameter, passed by reference
18 ; - error message text
19 ;
20 NEW MRADATA,IB364,IBCBASK,IBCBCOPY,IBCAN,IBIFNH,IBAUTO,IBDA
21 NEW IBCE,IBSILENT,IBPRCOB,IBERRMSG
22 NEW IBCOB,IBCOBIL,IBCOBN,IBINS,IBINSN,IBINSOLD,IBMRAIO,IBMRAO,IBNMOLD
23 S (IBIFN,IBIFNH)=+$G(IBIFN),IBEOB=+$G(IBEOB),ERRMSG=""
24 ;
25 S MRADATA=$G(^IBM(361.1,IBEOB,0))
26 I $P(MRADATA,U,1)'=IBIFN S ERRMSG="Incorrect Bill or MRA EOB" G AUCOBX
27 I $P(MRADATA,U,4)'=1 S ERRMSG="EOB is not a Medicare MRA" G AUCOBX
28 S IB364=+$P(MRADATA,U,19)
29 I 'IB364 S ERRMSG="Missing or incorrect Transmission record" G AUCOBX
30 ;
31 I '$P($G(^DGCR(399,IBIFN,"I"_($$COBN^IBCEF(IBIFN)+1))),U,1) D G AUCOBX
32 . S ERRMSG="No next payer for this bill"
33 . Q
34 ;
35 ; Make sure that Medicare WNR is the current insurance for this bill
36 I '$$WNRBILL^IBEFUNC(IBIFN) D G AUCOBX
37 . S ERRMSG="Medicare (WNR) is not the current payer for this bill"
38 . Q
39 ;
40 ; Set variable flags for use in IBCCCB/IBCCC2
41 S (IBCBASK,IBCBCOPY,IBCAN,IBAUTO,IBCE("EDI"),IBSILENT,IBPRCOB)=1
42 S IBDA=IBEOB
43 ;
44 D CHKB1^IBCCCB
45 ;
46 S IBIFN=IBIFNH ; restore bill#
47 I $G(IBERRMSG)'="" S ERRMSG=IBERRMSG G AUCOBX ; error message
48 D UPDEDI^IBCEM(IB364,"Z") ; status updates
49AUCOBX ;
50 Q
51 ;
52 ;
53AUTH(IBIFN,ERRMSG) ; Entry Point
54 ; This procedure's job is to authorize this bill. The manual
55 ; process to authorize a bill is found in routine IBCB1. This
56 ; routine borrows heavily from that routine.
57 ;
58 ; *** Any changes here should be considered also in IBCB1 ***
59 ;
60 ; This routine is called when receiving an incoming MRA from
61 ; Medicare. If that MRA/EOB meets certain criteria, then the bill
62 ; will become a secondary bill and we will try to authorize it (using
63 ; this procedure) and put it in the EDI queue ready for extract.
64 ;
65 ; Input
66 ; IBIFN - internal bill#
67 ;
68 ; Output
69 ; ERRMSG - optional output parameter, passed by reference
70 ; - error message text
71 ;
72 NEW CST,IBTXSTAT,IB364,PRCASV,DFN,STSMSG
73 NEW DIE,DA,DR,IBYY
74 ;
75 ; Check the bill, make sure the current status is valid
76 S IBIFN=+$G(IBIFN),ERRMSG=""
77 S CST=$P($G(^DGCR(399,IBIFN,0)),U,13)
78 I CST="" S ERRMSG="Bill has no current status defined." G AUTHX
79 I CST'=2 S ERRMSG="This bill's status is "_$$GET1^DIQ(399,IBIFN_",",.13)_". It must be REQUEST MRA." G AUTHX
80 ;
81 ; authorize the bill quietly
82 S DIE=399,DA=IBIFN,DR="[IB STATUS]",IBYY="@902" D ^DIE
83 ;
84 ; Update the review status for all EOB's on file
85 D STAT^IBCEMU2(IBIFN,3) ; Accepted - Complete EOB
86 ;
87 ; Checks for need to add any codes to bill for EDI (call in quiet mode)
88 D AUTOCK^IBCEU2(IBIFN,1)
89 ;
90 ; Calculate transmittable status
91 ; 0 = not transmittable
92 ; 1 = yes, live transmittable
93 ; 2 = yes, test transmittable
94 S IBTXSTAT=+$$TXMT^IBCEF4(IBIFN)
95 ;
96 ; If transmittable, add this bill to the bill transmission file
97 I IBTXSTAT D I ERRMSG'="" G AUTHX
98 . S IB364=$$ADDTBILL^IBCB1(IBIFN,IBTXSTAT)
99 . I '$P(IB364,U,3) S ERRMSG="Error loading bill into transmit file."
100 . Q
101 ;
102 ; Pass completed bill to Accounts Receivable (quietly)
103 D ARPASS^IBCB1(IBIFN,0)
104 I '$G(PRCASV("OKAY")) S ERRMSG="Error while passing bill to A/R." G AUTHX
105 ;
106 ; Find and process any IB charges on hold
107 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2)
108 D FIND^IBOHCK(DFN,IBIFN)
109 ;
110 ; If transmittable, check for unreviewed items & update 364 status
111 I IBTXSTAT D
112 . S STSMSG=$$STATUS^IBCEF4(IBIFN)
113 . I $P(STSMSG,U,1) D UPDEDI^IBCEM($P(STSMSG,U,1),"E")
114 . I $P(STSMSG,U,2),$P(STSMSG,U,2)'=$P(STSMSG,U,1) D UPDEDI^IBCEM($P(STSMSG,U,2),"E")
115 . Q
116 ;
117AUTHX ;
118 Q
119 ;
Note: See TracBrowser for help on using the repository browser.