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

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1IBCECOB5 ;ALB/TMP - IB COB MANAGEMENT SCREEN ;31-JAN-01
2 ;;2.0;INTEGRATED BILLING;**137,155,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5INIT ;
6 S IBDA=+$O(IBDA(0))
7 Q:'IBDA
8 D BLD(IBDA)
9 S VALMBG=1
10 Q
11 ;
12BLD(IBDA) ; Build list entrypoint
13 N IB,IBIFN,IBVCNT,X,Z,IBCNT,CNT,IBREC,IBIFN1,IBPTRESP
14 K ^TMP("IBCECOB-X",$J)
15 S VALMCNT=0
16 S IB=$G(^TMP("IBCECOB1",$J,IBDA)),IBCNT=$P(IB,"^",10)
17 S IBVCNT=$G(^TMP("IBCECOB",$J,IBDA)),IBIFN=$P(IBVCNT,U,2),IBVCNT=+IBVCNT
18 Q:'IBVCNT
19 S Z=IBVCNT-1
20 F S Z=$O(^TMP("IBCECOB",$J,"IDX",Z)) Q:'Z!('$D(^TMP("IBCECOB",$J,"IDX",+Z,IBDA))) D SET($G(^TMP("IBCECOB",$J,Z,0)))
21 D SET("")
22 S X=$E(" Original Billed Amt: $"_$$A10^IBCECSA5(+$P(IB,U,2))_$J("",40),1,40)
23 S X=X_$S($G(IBSRC):" Total A/R Payments: $"_$$A10^IBCECSA5($P(IB,U,3)),1:"Unreimburse Medicare Exp: $"_$$A10^IBCECSA5(+$G(^IBM(361.1,IBCNT,1))))
24 D SET(X)
25 ;
26 S IBIFN1=$P($G(^IBM(361.1,IBCNT,0)),U,1) ; bill#
27 S IBPTRESP=$P($G(^IBM(361.1,IBCNT,1)),U,2) ; Pt Resp Amt 1.02 field
28 ; Override Pt Resp Amt for bills with Form Type UB-04
29 I $$FT^IBCEF(IBIFN1)=3 S IBPTRESP=$$PTRESPI^IBCECOB1(IBCNT)
30 ;
31 S X=$E($S($G(IBSRC):" Bill Balance: $"_$$A10^IBCECSA5(+$P(IB,U,4)),1:" Pt Resp Amt: $"_$$A10^IBCECSA5(IBPTRESP))_$J("",40),1,40)
32 I '$G(IBSRC) N IBCALC,IBIFN S IBIFN=+$G(^IBM(361.1,IBCNT,0)) D MRACALC^IBCEMU2(IBCNT,IBIFN,0,.IBCALC)
33 S X=X_$S($G(IBSRC):" Total Amt This EOB: $"_$$A10^IBCECSA5($P(IB,U,17)),1:" Medicare Contract Adj: $"_$$A10^IBCECSA5($G(IBCALC("MEDCA"))))
34 D SET(X)
35 D SET("")
36 I $G(IBSRC) D
37 . S X=" Days Since Last Transmit: "_+$P(IB,U,12)
38 . D SET(X)
39 . S X=" Authorizing Biller: "_$P(IB,U,8)
40 . D SET(X)
41 . S X=" COB History: "
42 . I $P(IB,U,11)'="" D
43 .. F Z=1:1:$L($P(IB,U,11),";") S X=X_$P($P(IB,U,11),";",Z) D SET(X) S X=$J("",27)
44 . E D
45 .. S X=X_"NONE FOUND" D SET(X)
46 I '$G(IBSRC) S CNT=20,IBREC=$G(^IBM(361.1,IBCNT,0)) K ^TMP("IBCECSD",$J) D MRALLA^IBCECSA5 M ^TMP("IBCECOB-X",$J)=^TMP("IBCECSD",$J) K ^TMP("IBCECSD",$J)
47 ;
48 Q
49 ;
50EXIT ; -- exit code --
51 K ^TMP("IBCECOB-X",$J),IBDA
52 D CLEAN^VALM10
53 Q
54 ;
55HDR1 ; -- header code
56 ; Assume IBIFN and IBZIEN are defined
57 N IBCOB,IBINS
58 K VALMHDR
59 S IBINS=$$FINDINS^IBCEF1(IBIFN)
60 S VALMHDR(1)=IORVON_" BILL #:"_$$BN^PRCAFN(IBIFN)_IORVOFF
61 S VALMHDR(1)=$J("",80-$L(VALMHDR(1))\2)_VALMHDR(1)
62 S VALMHDR(2)=" INSURANCE COMPANY: "_$P($G(^DIC(36,+IBINS,0)),U)
63 S VALMHDR(3)=" "_IOUON_"Svc Date Patient Name/Last 4 Care Type/Form COB/SEQ"_IOUOFF
64 S Z=$G(^TMP("IBCECOB",$J,IBZIEN,0))
65 S VALMHDR(4)=" "_$E(Z,17,$L(Z))
66 Q
67 ;
68EXIT1 ; -- exit code --
69 K ^TMP("IBCECSD",$J)
70 D CLEAN^VALM10
71 Q
72 ;
73VEOB ;View an EOB from EOB Management
74 N IBDA,IBCNT,IBIFN,Z,VALMCNT,IBZIEN,IBONE
75 ;
76 D FULL^VALM1
77 D SEL^IBCECOB2(.IBDA,1)
78 S IBDA=+$O(IBDA(0))
79 I IBDA D EN^VALM("IBCEM EOB VIEW EOB")
80 S VALMBCK="R"
81 Q
82 ;
83INIT1 ;
84 S IBCNT=+$P($G(IBDA(IBDA)),U,3)
85 S IBIFN=+$G(IBDA(IBDA)),IBZIEN=+$G(^TMP("IBCECOB",$J,IBDA)),IBONE=1
86 Q:'IBCNT!'IBIFN!'IBZIEN
87 D HDR1
88 D BLD^IBCECSA6
89 Q
90 ;
91SET(X) ;set up list manager screen array
92 S VALMCNT=VALMCNT+1
93 S ^TMP("IBCECOB-X",$J,VALMCNT,0)=X
94 Q
95 ;
Note: See TracBrowser for help on using the repository browser.