1 | IBCECSA3 ;ALB/CXW - CLAIMS STATUS AWAITING RESOLUTION REPORT ;23-JUL-99
|
---|
2 | ;;2.0;INTEGRATED BILLING;**137,320**;21-MAR-94
|
---|
3 | Q
|
---|
4 | EN ; Report of claims status awaiting resolution
|
---|
5 | D FULL^VALM1
|
---|
6 | W !!,"You will need a 132 column printer for this report!",!
|
---|
7 | ;
|
---|
8 | N %ZIS,ZTSAVE,ZTRTN,ZTDESC
|
---|
9 | S %ZIS="QM" D ^%ZIS Q:POP
|
---|
10 | I $D(IO("Q")) K IO("Q") D Q
|
---|
11 | . S ZTRTN="LIST^IBCECSA3"
|
---|
12 | . S ZTSAVE("IBSORT1")=""
|
---|
13 | . S ZTSAVE("IBSORT2")=""
|
---|
14 | . S ZTSAVE("IBSORT3")=""
|
---|
15 | . S ZTSAVE("IBSORTOR")=""
|
---|
16 | . S ZTSAVE("^TMP(""IBCECSB"",$J,")=""
|
---|
17 | . S ZTDESC="IB -Claims Status Awaiting Resolution Report" D ^%ZTLOAD K ZTSK D HOME^%ZIS
|
---|
18 | U IO
|
---|
19 | LIST ; display
|
---|
20 | N IBSTOP,X,IBPAGE,IBX,IBDIV,IBDA,IBPAY,IB,IBZ,IBZFT,IBFST,IBX2
|
---|
21 | W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
|
---|
22 | S (IBSTOP,IBPAGE,IBFST,IBDIV)=0
|
---|
23 | I IBSORT1="D" S IBDIV=1
|
---|
24 | I '$D(^TMP("IBCECSB",$J)) D G LISTQ
|
---|
25 | . D HDR1 W !,"No entries found for this report"
|
---|
26 | S IBX="" F S IBX=$O(^TMP("IBCECSB",$J,IBX)) Q:IBX=""!IBSTOP S IBX2="" F S IBX2=$O(^TMP("IBCECSB",$J,IBX,IBX2)) Q:IBX2=""!IBSTOP S IBX3="" F S IBX3=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3)) Q:IBX3=""!IBSTOP D
|
---|
27 | . I 'IBFST S IBPAY=$$IBPAY(IBX,IBX2,IBX3) D HDR1 S:'IBDIV IBFST=1 Q:IBSTOP
|
---|
28 | . S IBDA=0 F S IBDA=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,IBDA)) Q:'IBDA!IBSTOP S IB=$G(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,IBDA)) D
|
---|
29 | .. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
|
---|
30 | .. W $$BN1^PRCAFN(+IB),?13,$E($P(IB,U,2),1,25),?40,$E($P(IB,U,3),1,30),?72,$P($P(IB,U,4),"~"),?78,$$DAT1^IBOUTL($P(IB,U,5)),?88,$E($P(IB,U,7),1,10),?100,"$"_$J($P(IB,U,6),0,2),?110,$P(IB,U,10),?122,$P(IB,U,11),!
|
---|
31 | .. W " FORM TYPE: "_$P($G(^IBE(353,$P($G(^DGCR(399,+IB,0)),U,19),0)),U),!
|
---|
32 | .. I 'IBDIV S X=" DIVISION: "_$P(IB,U,8) W X,$J(" ",40-$L(X))_"AUTHORIZING BILLER: "_$P($P(IB,U,9),"~",1),!
|
---|
33 | .. W " MESSAGE TEXT: " S IBZFT=0
|
---|
34 | .. S IBZ=0 F S IBZ=$O(^IBM(361,IBDA,1,IBZ)) Q:'IBZ D Q:IBSTOP
|
---|
35 | ... W:'IBZFT ?15 S X=$G(^IBM(361,IBDA,1,IBZ,0))
|
---|
36 | ... F I=1:131:$L(X) W " "_$E(X,I,I+130),!
|
---|
37 | ... S IBZFT=1
|
---|
38 | ... I ($Y+5)>IOSL D HDR1 Q:IBSTOP
|
---|
39 | .. W !
|
---|
40 | G:IBSTOP LISTQ
|
---|
41 | I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR
|
---|
42 | LISTQ I $D(ZTQUEUED) S ZTREQ="@" Q
|
---|
43 | W ! D ^%ZISC
|
---|
44 | Q
|
---|
45 | IBPAY(IBX,IBX2,IBX3) ; return biller name
|
---|
46 | N X
|
---|
47 | S X=$O(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,0))
|
---|
48 | S X=$G(^TMP("IBCECSB",$J,IBX,IBX2,IBX3,X))
|
---|
49 | Q $P($P(X,U,9),"~",1)
|
---|
50 | HDR1 ;
|
---|
51 | N DIR,Y
|
---|
52 | I IBPAGE D Q:IBSTOP
|
---|
53 | . I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBSTOP=('Y) Q:IBSTOP
|
---|
54 | . W @IOF
|
---|
55 | S IBPAGE=IBPAGE+1
|
---|
56 | W !,"Sort 1: ",$$SD^IBCECSA(IBSORT1)
|
---|
57 | W ?46,"Claims Status Awaiting Resolution Report",?120,$J("Page: "_IBPAGE,11)
|
---|
58 | W !,"Sort 2: ",$S($G(IBSORT2)'="":$$SD^IBCECSA(IBSORT2),1:"n/a")
|
---|
59 | W ?104,$J("Run Date: "_$$HTE^XLFDT($H,"2Z"),27)
|
---|
60 | W !,"Sort 3: ",$S($G(IBSORT3)'="":$$SD^IBCECSA(IBSORT3),1:"n/a")
|
---|
61 | I IBDIV W !!,"Division: "_$S($G(IBX)=0:"",1:$G(IBX)),!,"Authorizing Biller: "_$G(IBPAY)
|
---|
62 | W !,?72,"Last",?78,"Date of",?88,"Location",?100,"Current",?110,"Source of",?122,"Days Msg"
|
---|
63 | W !,"Bill #",?13,"Payer Name",?40,"Patient Name",?72,"4 SSN",?78,"Service",?88,"of Service",?100,"Balance",?110,"Message",?122,"Pending"
|
---|
64 | W !,$TR($J("",132)," ","-"),!
|
---|
65 | Q
|
---|
66 | ;
|
---|
67 | ;
|
---|
68 | RESORT ; CSA screen re-sort action
|
---|
69 | NEW DIR,X,Y,Z,IBSAVE,VALMQUIT,IBCURR
|
---|
70 | D FULL^VALM1 S VALMBCK="R"
|
---|
71 | W !!?2,"The CSA screen is currently sorted in the following manner:"
|
---|
72 | W !!?9,"Primary Sort: ",$S($G(IBSORT1)'="":$$SD^IBCECSA(IBSORT1),1:"n/a")
|
---|
73 | W !?7,"Secondary Sort: ",$S($G(IBSORT2)'="":$$SD^IBCECSA(IBSORT2),1:"n/a")
|
---|
74 | W !?8,"Tertiary Sort: ",$S($G(IBSORT3)'="":$$SD^IBCECSA(IBSORT3),1:"n/a")
|
---|
75 | ;
|
---|
76 | W !
|
---|
77 | S DIR(0)="Y",DIR("A")="Would you like to change the sort criteria"
|
---|
78 | S DIR("B")="Yes" D ^DIR K DIR
|
---|
79 | I 'Y G RESORTX
|
---|
80 | ;
|
---|
81 | ; save the old sort criteria
|
---|
82 | S IBSAVE=$G(IBSORT1)_U_$G(IBSORT2)_U_$G(IBSORT3)
|
---|
83 | S Z="" F S Z=$O(IBSORTOR(Z)) Q:Z="" S IBSAVE=IBSAVE_U_Z_U_IBSORTOR(Z)
|
---|
84 | ;
|
---|
85 | W !
|
---|
86 | K IBSORTOR
|
---|
87 | D SORT^IBCECSA(1,$P(IBSAVE,U,1)) I $G(VALMQUIT) G RES1
|
---|
88 | D SORT^IBCECSA(2) I $G(VALMQUIT) G RES1
|
---|
89 | I $G(IBSORT2)'="" D SORT^IBCECSA(3) I $G(VALMQUIT) G RES1
|
---|
90 | RES1 ;
|
---|
91 | I $G(IBSORT1)="" S IBSORT1=$P(IBSAVE,U,1) ; need at least one
|
---|
92 | ;
|
---|
93 | ; see if the sort criteria changed
|
---|
94 | S IBCURR=$G(IBSORT1)_U_$G(IBSORT2)_U_$G(IBSORT3)
|
---|
95 | S Z="" F S Z=$O(IBSORTOR(Z)) Q:Z="" S IBCURR=IBCURR_U_Z_U_IBSORTOR(Z)
|
---|
96 | I IBSAVE=IBCURR G RESORTX ; no sort changes made at all
|
---|
97 | ;
|
---|
98 | ; time to rebuild the list because sorts have changed
|
---|
99 | I $G(IBDAYS)="" S IBDAYS=0
|
---|
100 | I $G(IBSEV)="" S IBSEV="R"
|
---|
101 | D BLD^IBCECSA1
|
---|
102 | S VALMBCK="R",VALMBG=1
|
---|
103 | ;
|
---|
104 | RESORTX ;
|
---|
105 | Q
|
---|
106 | ;
|
---|
107 | MCS ; Link to the Multiple CSA Message Management option
|
---|
108 | NEW IBCSAMCS S IBCSAMCS=1
|
---|
109 | D FULL^VALM1 S VALMBCK="R"
|
---|
110 | I '$$KCHK^XUSRB("IB MESSAGE MANAGEMENT") D G MCSX
|
---|
111 | . W !!?5,"You must hold the IB MESSAGE MANAGEMENT key to access this option."
|
---|
112 | . D PAUSE^VALM1
|
---|
113 | . Q
|
---|
114 | ;
|
---|
115 | D ; call the MCS screen
|
---|
116 | . NEW IBSORT1,IBSORT2,IBSORT3,IBDAYS,IBSEV ; protect CSA vars
|
---|
117 | . D EN^IBCEMCL
|
---|
118 | . Q
|
---|
119 | ;
|
---|
120 | I $G(IBCSAMCS)=2 D BLD^IBCECSA1 S VALMBG=1 ; rebuild CSA
|
---|
121 | S VALMBCK="R"
|
---|
122 | MCSX ;
|
---|
123 | Q
|
---|
124 | ;
|
---|