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

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1IBCEOB2 ;ALB/TMP - EOB LIST FOR MANUAL MAINTENANCE ;18-FEB-99
2 ;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-94
3 Q
4 ;
5EN ; Enter/edit an EOB manually for a bill
6 ; MRA's cannot be manually entered
7 N VALMCNT,VALMBG,VALMHDR
8 S VALMCNT=0,VALMBG=1
9 D EN^VALM("IBCE EOB LIST")
10 Q
11 ;
12HDR ; -- header code
13 N IBCOB,IBINS,IBINSNM
14 K VALMHDR
15 S IBINS=$$CURR^IBCEF2(IBIFN),IBINSNM=$P($G(^DIC(36,+IBINS,0)),U)
16 S IBCOB=$P("^PRIMARY^SECONDARY^TERTIARY",U,$$COBN^IBCEF(IBIFN)+1)
17 S VALMHDR(1)=IORVON_" BILL #:"_$$BN^PRCAFN(IBIFN)_IORVOFF
18 S VALMHDR(1)=$J("",80-$L(VALMHDR(1))\2)_VALMHDR(1)
19 S VALMHDR(2)=" CURRENT INSURANCE COMPANY ("_IBCOB_"): "_IBINSNM
20 I $D(^IBM(361.1,"B",IBIFN)) D
21 . S VALMHDR(3)=" "
22 . S VALMHDR(4)=" # SEQ PAYER"_$J("",15)_"EOB PAID DATE TYPE STATUS"
23 Q
24 ;
25INIT ; -- init variables and list array
26 ; Select bill
27 K VALMQUIT
28 S IBIFN=$$BILL(.VALMQUIT)
29INITQ Q
30 ;
31HELP ; -- help code
32 S X="?" D DISP^XQORM1 W !!
33 Q
34 ;
35EXIT ; -- exit code
36 K ^TMP("IBCEOB",$J),IBIFN,IBEOB
37 D CLEAR^VALM1
38 Q
39 ;
40BLD ; Build list template display - IBIFN must equal ien of bill in file 399
41 ;
42 N IB0,X,Y,IBCOB,IBCOBN,IB,IBCNT,IBEOB,IBSEQ,IBPDDT
43 S VALMCNT=0
44 K ^TMP("IBCEOB",$J)
45 S IB0=$G(^DGCR(399,+$G(IBIFN),0)),VALMCNT=0
46 S IBCOB=$P($$EXTERNAL^DILFD(399,.21,,$P(IB0,U,21))," "),IBCOBN=$$COBN^IBCEF(IBIFN)
47 ;
48 S IBCNT=0
49 I $D(^IBM(361.1,"B",IBIFN)) D ; Display existing EOB's for bill, if any
50 . K ^TMP("IB",$J)
51 . S IBEOB=0 F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D
52 .. S IB0=$G(^IBM(361.1,IBEOB,0))
53 .. S ^TMP("IB",$J,+$P(IB0,U,6),IBEOB)=IB0 ; Sort by EOB paid date
54 . ;
55 . S IBPDDT="" F S IBPDDT=$O(^TMP("IB",$J,IBPDDT)) Q:IBPDDT="" S IBEOB=0 F S IBEOB=$O(^TMP("IB",$J,IBPDDT,IBEOB)) Q:'IBEOB S IB0=$G(^(IBEOB)) I IB0'="" D
56 .. ;
57 .. S IBCNT=IBCNT+1
58 .. S IBSEQ=+$P(IB0,U,15)
59 .. S IB=" "_$E(IBCNT_" ",1,3)_$S(IBSEQ:"("_$P("P^S^T",U,IBSEQ)_") ",1:$J("",4))_$E($$EXTERNAL^DILFD(361.1,.02,"",$P(IB0,U,2))_$J("",18),1,18)_" "
60 .. S IB=IB_$E($$FMTE^XLFDT($P(IB0,U,6),"2")_$J("",18),1,18)_" "_$E($P("EOB^MRA",U,$P(IB0,U,4)+1)_$J("",5),1,5)_$$EXTERNAL^DILFD(361.1,.13,"",$P(IB0,U,13))
61 .. ;
62 .. D SET(IB,IBCNT,IBEOB)
63 . ;
64 . K ^TMP("IB",$J)
65 I 'IBCNT S IBCNT=IBCNT D SET(" NO EOB's FOUND FOR BILL #"_$$BN^PRCAFN(IBIFN))
66 ;
67 Q
68 ;
69SET(X,CNT,IBEOB) ;set list manager screen arrays
70 S VALMCNT=VALMCNT+1
71 S ^TMP("IBCEOB",$J,VALMCNT,0)=X
72 I $G(IBEOB) D
73 . S ^TMP("IBCEOB",$J,"IDX",VALMCNT,CNT)=""
74 . S ^TMP("IBCEOB",$J,CNT)=VALMCNT_U_IBEOB
75 Q
76 ;
77BILL(VALMQUIT,IBX) ; Select bill
78 ; VALMQUIT = pass by reference to determine if protocol should quit
79 ; IBX = pass by reference to return 1 if timeout or ^ entered
80 ;
81 ; Must be printed/txmt or closed status, have a current insurance and
82 ; not having MEDICARE WNR as its primary insurance with the COB sequence
83 ; of the bill being primary
84 ;
85 N DIC,DA,X,Y,IBIFN
86 K VALMQUIT
87 S IBX=0
88 S DIC="^DGCR(399,",DIC(0)="AEMQ",DIC("S")="N IBY S IBY=Y I $P(^(0),U,13)'="""",""04""[$P(^(0),U,13),$D(^(""I1"")),$S($$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(+IBY)):+$$COBN^IBCEF(+IBY)'=1,1:1)" D ^DIC K DIC
89 S IBIFN=+Y,IBX=($G(DTOUT)!($G(DUOUT)))
90 I IBIFN'>0 S VALMQUIT=1 G BILLQ
91 I IBIFN>0 D BLD,HDR
92BILLQ Q IBIFN
93 ;
Note: See TracBrowser for help on using the repository browser.