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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1IBCECOB ;ALB/CXW - IB COB MANAGEMENT SCREEN ;16-JUN-1999
2 ;;2.0;INTEGRATED BILLING;**137,155,288**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for COB management
6 K IBSRT,IBMRADUP
7 D EN^VALM("IBCEM MRA MANAGEMENT")
8 Q
9 ;
10HDR ; -- header code
11 Q
12 ;
13INIT ; -- init variables and list array
14 N DIC,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,DIR,IB1
15 K ^TMP("IBBIL",$J)
16 S IBSRT=""
17 S IB1=1
18 W !
19 F S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Select "_$S('IB1:"Another ",1:"")_"BILLER: "_$S('IB1:"",1:"ALL//") D ^DIC K DIC D Q:Y<0
20 . Q:Y<0
21 . I $D(^TMP("IBBIL",$J,+Y)) W !,"This biller has already been selected" Q
22 . S ^TMP("IBBIL",$J,+Y)=""
23 . S IB1=0
24 I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
25 ;
26 S DIR("A")="Sort By: ",DIR("B")="BILLER"
27 S DIR(0)="SBA^B:BILLER;D:DAYS SINCE TRANSMISSION OF LATEST BILL;L:DATE LAST MRA RECEIVED;I:SECONDARY INSURANCE COMPANY;M:MRA STATUS;P:PATIENT NAME;R:PATIENT RESPONSIBILITY;S:SERVICE DATE"
28 S DIR("?")="Enter the code to indicate how the list should be sorted." D ^DIR K DIR
29 I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
30 S IBSRT=Y
31 ;
32 W !
33 S IBMRADUP=0
34 S DIR("A")="Do you want to include Denied MRAs for Duplicate Claim/Service",DIR("B")="No",DIR(0)="YO"
35 D ^DIR K DIR
36 I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
37 I Y S IBMRADUP=1
38 ;
39 D BLD^IBCECOB1
40INITQ Q
41 ;
42HELP ; -- help code
43 S X="?" D DISP^XQORM1 W !!
44 Q
45 ;
46EXIT ; -- exit code
47 K ^TMP("IBCECOB",$J),^TMP("IBCOBST",$J),^TMP("IBBIL",$J)
48 K ^TMP("IBCECOB1",$J),^TMP("IBCOBSTX",$J)
49 D CLEAN^VALM10
50 Q
51 ;
52EXP ; -- expand code to show additional details of the EOB record
53 NEW IBDA,IBIFN,LSTENTRY
54 D SEL^IBCECOB2(.IBDA,1) ; selects a bill
55 S LSTENTRY=+$O(IBDA(0)) I 'LSTENTRY G EXPQ ; list entry number
56 S IBIFN=+$G(IBDA(LSTENTRY)) I 'IBIFN G EXPQ ; bill#
57 ;
58 ; If only one MRA on file, call the listman screen and quit
59 I $$MRACNT^IBCEMU1(IBIFN)=1 D EN^VALM("IBCEM MRA DETAIL") G EXPQ
60 ;
61EXPLOOP ; At this point, we know there are multiple MRA's on file
62 ;
63 D FULL^VALM1
64 I $$SEL^IBCEMU1(IBIFN,1,LSTENTRY) D G EXPLOOP ; MRA lister/selection
65 . NEW IBIFN,LSTENTRY,IBDASAVE ; protect variables
66 . M IBDASAVE=IBDA ; save off IBDA array
67 . D EN^VALM("IBCEM MRA DETAIL") ; call the listman
68 . M IBDA=IBDASAVE ; restore IBDA array
69 . Q
70EXPQ ;
71 S VALMBCK="R"
72 Q
73 ;
74COBPOSS(IB364) ; Returns 1 if transmit bill ien in IB364 is currently
75 ; in a status where COB may be performed on the bill
76 ; Used by index "ACOB", file 364
77 N IBWNR,IBNSEQ,IB01,IBM1,IBU1,IB0,IBOK,IBMRA
78 S IBOK=1
79 S IB0=$G(^IBA(364,IB364,0))
80 S IBWNR=$$WNRBILL^IBEFUNC(+IB0),IBMRA=$P($G(^DGCR(399,+IB0,"TX")),U,5)
81 S IB01=$G(^DGCR(399,+IB0,0)),IBM1=$G(^("M1")),IBU1=$G(^("U1"))
82 I 'IBWNR,IBU1-$P(IBU1,U,2)'>0 S IBOK=0 G COBQ ; Bill has a 0 balance
83 I $S('IBWNR:$E($P(IB0,U,3))'="A",1:IBMRA'="1N"&(IBMRA'="A")) S IBOK=0 G COBQ ; Not in correct transmit status
84 S IBNSEQ=+$TR($P(IB0,U,8),"PST","230")
85 I 'IBNSEQ!'$D(^DGCR(399,+IB0,"I"_IBNSEQ)) S IBOK=0 G COBQ ; No next ins
86 I "234"'[$P(IB01,U,13) S IBOK=0 G COBQ ; Bill invalid status for COB
87 I IBNSEQ D
88 . N Z,IBSTOP
89 . S IBSTOP=0
90 . F Z=IBNSEQ:1:3 D Q:IBSTOP
91 .. I $D(^DGCR(399,+IB0,"I"_Z)) D
92 ... ;Insurance must reimburse
93 ... I $P($G(^DIC(36,+^DGCR(399,+IB0,"I"_Z),0)),U,2)="N" S IBOK=0 Q
94 ... I $P(IBM1,U,4+Z) S IBOK=0,IBSTOP=1 Q ; Already has a next seq bill
95 ... S (IBOK,IBSTOP)=1
96 ;
97COBQ Q IBOK
98 ;
Note: See TracBrowser for help on using the repository browser.