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

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

revised back to 6/30/08 version

File size: 4.8 KB
Line 
1IBCECSA3 ;ALB/CXW - CLAIMS STATUS AWAITING RESOLUTION REPORT ;23-JUL-99
2 ;;2.0;INTEGRATED BILLING;**137,320**;21-MAR-94
3 Q
4EN ; 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
19LIST ; 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
42LISTQ I $D(ZTQUEUED) S ZTREQ="@" Q
43 W ! D ^%ZISC
44 Q
45IBPAY(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)
50HDR1 ;
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 ;
68RESORT ; 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
90RES1 ;
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 ;
104RESORTX ;
105 Q
106 ;
107MCS ; 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"
122MCSX ;
123 Q
124 ;
Note: See TracBrowser for help on using the repository browser.