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

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

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1IBCNBAR ;ALB/ARH-Ins Buffer: process Accept and Reject ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82,240,345**;21-MAR-94;Build 28
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;
6ACCEPT(IBBUFDA,DFN,IBINSDA,IBGRPDA,IBPOLDA,IBMVINS,IBMVGRP,IBMVPOL,IBNEWINS,IBNEWGRP,IBNEWPOL) ; move buffer data into Insurance files then cleanup
7 ; 1) data moved into insurance files, new records created if needed or edit existing ones
8 ; 2) complete some general functions that are executed whenever insurance is entered/edited
9 ; 3) allow user to view buffer entry and new/updated insurance records
10 ; 4) buffer ins/group/policy data deleted
11 ; 5) buffer entry status updated
12 ;
13 ;
14PROCESS ; process all changes selected by user, add/edit insurance files based on buffer data
15 ;
16 N IVMINSUP,IBNEW,IBCDFN S IBCDFN=IBPOLDA S:+IBNEWPOL IBNEW=1 D BEFORE^IBCNSEVT ; insurance event driver
17 ;
18 N DIR,X,Y,IBX,IBINSH,IBGRPH,IBPOLH S (IBINSH,IBGRPH,IBPOLH)="Updated" W " ...",!
19 ;
20 I +IBNEWINS S IBINSDA=+$$NEWINS^IBCNBMN(IBBUFDA) G:'IBINSDA ACCPTQ S IBINSH="Created"
21 I +IBNEWGRP S IBGRPDA=+$$NEWGRP^IBCNBMN(IBBUFDA,+IBINSDA) G:'IBGRPDA ACCPTQ S IBGRPH="Created"
22 I +IBNEWPOL S IBPOLDA=+$$NEWPOL^IBCNBMN(IBBUFDA,+IBINSDA,+IBGRPDA) G:'IBPOLDA ACCPTQ S IBPOLH="Created"
23 ;
24 I +IBINSDA,+IBMVINS D INS^IBCNBMI(IBBUFDA,IBINSDA,+IBMVINS) W !,"Insurance Company "_IBINSH_"..."
25 I +IBINSDA,+IBMVGRP,+IBGRPDA D GRP^IBCNBMI(IBBUFDA,IBGRPDA,+IBMVGRP) W !,"Group/Plan "_IBGRPH_"..."
26 I +IBINSDA,+IBMVPOL,+IBGRPDA,+IBPOLDA D POLICY^IBCNBMI(IBBUFDA,IBPOLDA,+IBMVPOL) W !,"Patient Policy "_IBPOLH_"..."
27 ;
28CLEANUP ; general updates and checks done whenever insurance is added/edited and clean up buffer file
29 N IBSOURCE S IBSOURCE=$P($G(^IBA(355.33,IBBUFDA,0)),U,3)
30 ;
31 I +IBPOLDA D PAT^IBCNBMI(DFN,IBPOLDA) ; update DOB&SSN of Pat Ins from Pat file
32 D POL^IBCNSU41(DFN) ; update Tricare sponsor data
33 D COVERED^IBCNSM31(DFN) ; update 'Covered by Insurance' field (2,.3192
34 I +IBSOURCE=3 D IVM(1,IBBUFDA) ; update/notify IVM
35 I +IBINSDA,+IBPOLDA S IBX=$$DUPCO^IBCNSOK1(DFN,IBINSDA,IBPOLDA,1) ; warning if duplicate policy added for patient
36 I +IBGRPDA S IBX=$$DUPPOL^IBCNSOK1(IBGRPDA,1) ; warning if duplicate plan was added
37 I +IBNEWPOL I +$$PTHLD^IBOHCR(DFN,1,1) W !!,"Patient's bills On Hold date updated due to new insurance."
38 I $$HOLD^IBCNBLL(DFN) W !!,"There are bills On Hold for this patient."
39 ;
40 W !! S DIR(0)="FO",DIR("A")="Press 'V' to view the changes or Return to continue" D ^DIR
41 I Y="V"!(Y="v") W !! D INS^IBCNBCD(IBBUFDA,IBINSDA),WAIT^IBCNBUH,GRP^IBCNBCD(IBBUFDA,IBGRPDA),WAIT^IBCNBUH,POLICY^IBCNBCD(IBBUFDA,IBPOLDA),WAIT^IBCNBUH
42 ;
43 ; update buffer file entry so only stub remains and status is changed
44 D STATUS^IBCNBEE(IBBUFDA,"A",IBNEWINS,IBNEWGRP,IBNEWPOL) ; update buffer entry's status to accepted
45 D DELDATA^IBCNBED(IBBUFDA) ; delete buffer's insurance/patient data
46 ;
47 S IBCDFN=IBPOLDA S:+IBSOURCE=3 IVMINSUP=1 D AFTER^IBCNSEVT,^IBCNSEVT ; insurance event driver
48 ;
49ACCPTQ Q
50 ;
51 ;
52REJECT(IBBUFDA) ; process a buffer entry reject
53 ; 1) update/notify IVM
54 ; 2) buffer ins/group/policy data deleted
55 ; 3) buffer entry status updated
56 ; 4) if patient has no other active insurance then release any patient bills On Hold
57 ;
58 N DFN S DFN=+$G(^IBA(355.33,+IBBUFDA,60))
59 ;
60 I +$P($G(^IBA(355.33,+IBBUFDA,0)),U,3)=3 D IVM(0,IBBUFDA)
61 ;
62 D STATUS^IBCNBEE(+IBBUFDA,"R",0,0,0),DELDATA^IBCNBED(+IBBUFDA) W " ... done."
63 ;
64 I +DFN,'$$INSURED^IBCNS1(DFN),'$$BUFFER^IBCNBU1(DFN) D
65 . I +$$PTHLD^IBOHCR(DFN,2,1) W !!,"Patient has no other active Insurance.",!,"All patient bills On Hold waiting for Insurance have been released." D WAIT^IBCNBUH
66 ;
67 Q
68 ;
69 ;
70IVM(AR,IBBUFDA) ; IVM must be notified whenever a buffer entry that originated in IVM is accepted or rejected
71 ; this lets them clean up their files since they also have a buffer type file of insurance uploaded from the IVM center
72 ; if rejected they then ask the user for a reason it was rejected
73 ; input: AR = 1 if accepted, 0 if rejected
74 ;
75 N DFN,IBX,IBY I $P($G(^IBA(355.33,+IBBUFDA,0)),U,3)'=3 Q
76 ;
77 S DFN=+$G(^IBA(355.33,+IBBUFDA,60))
78 S IBX=$P($G(^IBA(355.33,+IBBUFDA,20)),U,1)_U_$P($G(^IBA(355.33,+IBBUFDA,21)),U,1)_U_$P($G(^IBA(355.33,+IBBUFDA,40)),U,3)
79 ;
80 S IBY=$$UPDATE^IVMLINS4(DFN,AR,IBX)
81 Q
Note: See TracBrowser for help on using the repository browser.