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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1IBCECSA ;ALB/CXW - IB CLAIMS STATUS AWAITING RESOLUTION SCREEN ;28-JUL-1999
2 ;;2.0;INTEGRATED BILLING;**137,320**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for claims status awaiting resolution
6 N IBSORT,IBSORT1,IBSORT2,IBSORT3,IBSORTOR,IBDAYS
7 D EN^VALM("IBCEM CSA LIST")
8 Q
9 ;
10HDR ; -- header code
11 S VALMSG="* Indicates CSA review in progress"
12 Q
13 ;
14INIT ; -- init variables and list array
15 N DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,X,IBFIRST
16 K ^TMP("IBBIL",$J),^TMP("IBDIV",$J),VALMQUIT
17 S VALMCNT=0
18 ;
19 S DIR(0)="NA^0:999",DIR("B")=0,DIR("A")="MINIMUM # OF DAYS MSGS WAITING TO BE RESOLVED: ",DIR("?")="Enter the minimum number of days you want a message to have been waiting to be resolved before it will be displayed on this screen."
20 D ^DIR K DIR
21 I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
22 S IBDAYS=Y
23 ;
24 S IBFIRST=1
25 F S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")=$S(IBFIRST:"",1:" Another ")_"AUTHORIZING BILLER: "_$S(IBFIRST:"ALL// ",1:"") D ^DIC K DIC Q:Y<0 D
26 . I $D(^TMP("IBBIL",$J,+Y)) W !,"This biller has already been selected" Q
27 . S ^TMP("IBBIL",$J,+Y)="",IBFIRST=0
28 I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
29 ;
30 S IBFIRST=1
31 F S DIC="^DG(40.8,",DIC(0)="AEQMN",DIC("A")=$S(IBFIRST:"",1:" Another ")_"DIVISION: "_$S(IBFIRST:"ALL//",1:"") D ^DIC K DIC Q:Y<0 S ^TMP("IBDIV",$J,+Y)="",IBFIRST=0
32 I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
33 ;
34 ; IB*320 - new sorting
35 W !
36 K IBSORTOR
37 D SORT(1) I $G(VALMQUIT) G INITQ
38 D SORT(2) I $G(VALMQUIT) G INITQ
39 I $G(IBSORT2)'="" D SORT(3) I $G(VALMQUIT) G INITQ
40 ;
41 S DIR(0)="SA^R:REJECTS ONLY;B:BOTH INFORMATIONAL AND REJECTS",DIR("A")="(R)ejects only OR (B)oth informational and rejects?: "
42 S DIR("?",1)="YOU MAY CHOOSE TO SEE JUST THOSE MESSAGES WE KNOW ARE REJECTS OR YOU MAY",DIR("?")=" CHOOSE TO SEE ALL MESSAGES MEETING YOUR SELECTION CRITERIA",DIR("B")="REJECTS ONLY" W !! D ^DIR K DIR
43 I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
44 S IBSEV=Y
45 D BLD^IBCECSA1
46INITQ Q
47 ;
48HELP ; -- help code
49 S X="?" D DISP^XQORM1 W !!
50 S VALMSG="* Indicates review in progress"
51 Q
52 ;
53EXIT ; -- exit code
54 K IBDAYS,IBSORT1,IBSORT2,IBSORT3,IBSORTOR
55 K ^TMP("IBCECSA",$J),^TMP("IBDIV",$J),^TMP("IBBIL",$J)
56 K ^TMP("IBCECSB",$J),^TMP("IBCECSC",$J),^TMP("IBCECSD",$J)
57 D CLEAN^VALM10
58 Q
59 ;
60SORT(LVL,IBDEFSRT) ; CSA sort
61 ; LVL - sort level 1,2,or,3
62 ; IBDEFSRT - default sort value (optional)
63 NEW DIR,X,Y,LVLD,G,LN,S,SC,SCP,DTOUT,DUOUT,DIRUT,DIROUT,IBZ
64 K IBSORT3 I LVL<3 K IBSORT2 I LVL=1 K IBSORT1
65 I '$F(".1.2.3.","."_$G(LVL)_".") G SORTX
66 I $G(VALMQUIT) G SORTX
67 ;
68 I LVL>1,$G(IBSORT1)="" D SORT(1) I $G(IBSORT1)="" G SORTX
69 I LVL=3,$G(IBSORT2)="" D SORT(2) I $G(IBSORT2)="" G SORTX
70 ;
71 S LVLD=$S(LVL=2:"Secondary",LVL=3:"Tertiary",1:"Primary")
72 ;
73 S DIR("A")=LVLD_" Sort"
74 I LVL=1 S DIR("B")=$$SD("E")
75 I LVL>1 K DIR("B")
76 I LVL=2,IBSORT1=$G(IBDEFSRT) K IBDEFSRT
77 I LVL=3,IBSORT1=$G(IBDEFSRT)!(IBSORT2=$G(IBDEFSRT)) K IBDEFSRT
78 I $G(IBDEFSRT)'="" S DIR("B")=$$SD(IBDEFSRT) ; passed in default sort
79 ;
80 S DIR("?")="Enter a code from the list to indicate the "_LVLD_" sort order."
81 I LVL>1 S DIR("?",1)=" Primary Sort is "_$$SD($G(IBSORT1)),DIR("?",LVL)=""
82 I LVL=3 S DIR("?",2)="Secondary Sort is "_$$SD($G(IBSORT2))
83 ;
84 I LVL=1 S DIR(0)="SB" ; primary sort required
85 I LVL>1 S DIR(0)="SOB" ; optional sorts
86 ;
87 S G=""
88 F LN=1:1 S S=$P($T(ZZ+LN),";",3) Q:S="" D
89 . S SC=$P(S,":",1) ; sort code letter
90 . I LVL=2,IBSORT1=SC Q
91 . I LVL=3,IBSORT1=SC!(IBSORT2=SC) Q
92 . S SCP=$P(S,":",1,2) ; sort code:desc pair
93 . S G=$S(G="":SCP,1:G_";"_SCP)
94 . Q
95 ;
96 S $P(DIR(0),U,2)=G
97 ;
98 D ^DIR K DIR
99 I $D(DTOUT) S VALMQUIT=1 G SORTX ; timeout
100 I $D(DIRUT) S:LVL=1 VALMQUIT=1 G SORTX ; ^ or nil response
101 S @("IBSORT"_LVL)=Y,IBZ=Y
102 ;
103 I IBZ="N" D G SORTX ; number of days pending
104 . S IBSORTOR(IBZ)="D" ; this sort is always descending
105 . Q
106 ;
107 I IBZ="C" D G SORTX ; current balance question
108 . S DIR(0)="Y"
109 . S DIR("A")="Display Highest Balances First",DIR("B")="Yes"
110 . S DIR("A",1)=""
111 . S DIR("?",1)="Enter Yes or No."
112 . S DIR("?",2)=""
113 . S DIR("?",3)="Yes, I want to see the large balances first at the top of the list and the"
114 . S DIR("?",4)="small balances last at the bottom of the list."
115 . S DIR("?",5)=""
116 . S DIR("?",6)="No, I want to see the small balances first at the top of the list and the"
117 . S DIR("?")="large balances last at the bottom of the list."
118 . D ^DIR K DIR
119 . I $D(DTOUT) S VALMQUIT=1 Q ; timeout
120 . I $D(DIRUT) S:LVL=1 VALMQUIT=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
121 . I Y S IBSORTOR(IBZ)="D" ; yes, large first, descending
122 . I 'Y S IBSORTOR(IBZ)="A" ; no, small first, ascending
123 . Q
124 ;
125 I IBZ="S" D G SORTX ; Date of Service question
126 . S DIR(0)="Y"
127 . S DIR("A")="Display Oldest Claims First",DIR("B")="Yes"
128 . S DIR("A",1)=""
129 . S DIR("?",1)="Enter Yes or No."
130 . S DIR("?",2)=""
131 . S DIR("?",3)="Yes, I want to see claims with old dates of service at the top of the list"
132 . S DIR("?",4)="and claims with recent dates of service at the bottom of the list."
133 . S DIR("?",5)=""
134 . S DIR("?",6)="No, I want to see claims with recent dates of service at the top of the list"
135 . S DIR("?")="and older claims at the bottom of the list."
136 . D ^DIR K DIR
137 . I $D(DTOUT) S VALMQUIT=1 Q ; timeout
138 . I $D(DIRUT) S:LVL=1 VALMQUIT=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
139 . I Y S IBSORTOR(IBZ)="A" ; yes, old first, ascending sort
140 . I 'Y S IBSORTOR(IBZ)="D" ; no, new first, descending sort
141 . Q
142 ;
143 I IBZ="R" D G SORTX ; review status question
144 . S DIR(0)="Y"
145 . S DIR("A")="Display 'Review in Process' Messages Last",DIR("B")="Yes"
146 . S DIR("A",1)=""
147 . S DIR("?",1)="Enter Yes or No."
148 . S DIR("?",2)=""
149 . S DIR("?",3)="Yes, I want to group together status messages under review at the bottom of"
150 . S DIR("?",4)="the list."
151 . S DIR("?",5)=""
152 . S DIR("?",6)="No, I want to group together status messages under review at the top of the"
153 . S DIR("?")="list."
154 . D ^DIR K DIR
155 . I $D(DTOUT) S VALMQUIT=1 Q ; timeout
156 . I $D(DIRUT) S:LVL=1 VALMQUIT=1 K @("IBSORT"_LVL) Q ; ^ or nil resp
157 . I Y S IBSORTOR(IBZ)="A" ; yes, 1 at bottom, 0 at top, ascending
158 . I 'Y S IBSORTOR(IBZ)="D" ; no, 1 at top, 0 at bottom, descending
159 . Q
160 ;
161SORTX ;
162 Q
163 ;
164SD(SORT) ; sort description given the sort code letter
165 Q $P($P($T(@("ZZ"_$G(SORT))),";",3),":",2)
166 ;
167SV(SORT) ; sort value given the sort code letter
168 NEW S,VAR,VALUE
169 S S=$P($T(@("ZZ"_$G(SORT))),";",3)
170 S VAR=$P(S,":",4) ; variable name
171 S VALUE=$G(@VAR) ; value of variable
172 I VALUE="" S VALUE="~" G SVX ; get out if undefined
173 I '$P(S,":",3) G SVX ; non-numeric
174 I $G(IBSORTOR(SORT))="D" S VALUE=-VALUE ; descending sort
175SVX Q VALUE
176 ;
177ZZ ; List of allowable sort criteria
178ZZA ;;A:Authorizing Biller:0:IBUER;
179ZZB ;;B:Bill Number:0:IB;
180ZZC ;;C:Current Balance:1:IBOAM;
181ZZS ;;S:Date of Service:1:IBSER;
182ZZD ;;D:Division:0:IBDIV;
183ZZE ;;E:Error Code Text:0:IBERR;
184ZZN ;;N:Number of Days Pending:1:IBPEN;
185ZZM ;;M:Patient Name:0:IBPAT;
186ZZP ;;P:Payer:0:IBPAY;
187ZZR ;;R:Review in Process:1:IBREV;
188ZZL ;;L:SSN Last 4:0:IBSSN;
189 ;
Note: See TracBrowser for help on using the repository browser.