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

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

initial load of FOIAVistA 6/30/08 version

File size: 7.3 KB
Line 
1IBCECSA4 ;ALB/CXW - IB CLAIMS STATUS AWAITING RESOLUTION SCREEN ;5-AUG-1999
2 ;;2.0;INTEGRATED BILLING;**137,155,320,371**;21-MAR-1994;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5SMSG ;select message
6 N IBCOM,IBX,IBDAX,IBA
7 D SEL(.IBDAX,1)
8 I $O(IBDAX(""))="" G SMSGQ
9 S IBDAX=+$O(IBDAX(0)),IBA=$G(IBDAX(IBDAX))
10 S IBX=$G(^TMP("IBCECSB",$J,$P(IBA,U,3),$P(IBA,U,4),$P(IBA,U,6),$P(IBA,U,2)))
11 I IBX'="" D
12 . Q:'$$LOCK^IBCEU0(361,$P(IBA,U,2))
13 . D EN^VALM("IBCEM CSA MSG")
14 . D UNLOCK^IBCEU0(361,$P(IBA,U,2))
15SMSGQ S VALMBCK="R"
16 I $G(IBFASTXT) S VALMBCK="Q" K IBDAX
17 D:$O(IBDAX(0)) BLD^IBCECSA1
18 Q
19 ;
20COB ; COB management link from CSA
21 N IBA,IBX
22 ;IBX,IBA are killed during cancel execution
23 D FULL^VALM1
24 D EN^IBCECOB
25 I $D(IBFASTXT) K IBFASTXT
26 S VALMBCK="R"
27 Q
28 ;
29EDI ;History detail display
30 N IBIFN,IBX,IBA
31 D FULL^VALM1
32 S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(IBDAX))
33 D EDI2^IBCECOB2(IBIFN)
34 S VALMBCK="R"
35 Q
36EOB ;View an EOB
37 N IBIFN,IBA,IBX
38 D FULL^VALM1
39 S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(IBDAX))
40 D EN^VALM("IBCEM VIEW EOB")
41 Q
42 ;
43TPJI ;Third Party joint Inquiry
44 N IBIFN,IBX,IBA
45 D FULL^VALM1
46 S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(IBDAX))
47 D TPJI1^IBCECOB2(IBIFN)
48 S VALMBCK="R"
49 Q
50 ;
51PBILL ;Print bill - not for resubmit
52 ; IB*320 - allow action for MRA request claims
53 N IBIFN,IBX,IBA,IBRESUB
54 D FULL^VALM1
55 S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(+IBDAX))
56 I "234"'[$P($G(^DGCR(399,IBIFN,0)),U,13) W !!,"Bill status must be REQUEST MRA, AUTHORIZED or PRNT/TX to print the bill." D PAUSE^VALM1 G PB1
57 ;
58 ; don't update review status for MRA's
59 I $P($G(^DGCR(399,IBIFN,0)),U,13)=2 S IBRESUB=1
60 E S IBRESUB=$$RESUB(IBIFN,1,"PX")
61 I IBRESUB'>0 W !,*7,"This is not a transmittable bill or review not needed" D PAUSE^VALM1 G PB1
62 I IBRESUB=2 D G PB1
63 . N IB364
64 . S IB364=+$P($G(IBDAX(IBDAX)),U,5)
65 . D PRINT1^IBCEM03(IBIFN,.IBDAX,IB364)
66 D PBILL1^IBCECOB2(IBIFN)
67PB1 ;
68 S VALMBCK="R"
69 Q
70 ;
71CANCEL ;Cancel bill
72 N IBIFN,IB364,IBX,IBA,MRACHK
73 ; IBX,IBA will be killed during execution - need to protect them
74 D FULL^VALM1
75 S IBDAX=$O(IBDAX(0)),IBIFN=+$G(IBDAX(+IBDAX))
76 ; Check for security key
77 I '$$KCHK^XUSRB("IB AUTHORIZE") D G CANCELQ
78 . W !!?5,"You don't hold the proper security key to access this function."
79 . W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
80 . D PAUSE^VALM1
81 . Q
82 D MRACHK I MRACHK G CANCELQ
83 S IB364=+$P($G(IBDAX(IBDAX)),U,5)
84 D CANCEL^IBCEM3(.IBDAX,IBIFN,IB364)
85CANCELQ S VALMBCK="R"
86 Q
87 ;
88CLONE ;'Copy/cancel bill' protocol action
89 N IBX,IBA,IB364,MRACHK,IBIFN
90 ; IBX,IBA will be killed during execution - need to protect them
91 D FULL^VALM1
92 S IBDAX=$O(IBDAX("")),IBIFN=+$P($G(IBDAX(IBDAX)),U)
93 I IBDAX="" G CLONEQ
94 ; Check for security key
95 I '$$KCHK^XUSRB("IB AUTHORIZE") D G CLONEQ
96 . W !!?5,"You don't hold the proper security key to access this function."
97 . W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
98 . D PAUSE^VALM1
99 . Q
100 D MRACHK I MRACHK G CLONEQ
101 S IB364=+$P($G(IBDAX(IBDAX)),U,5)
102 D COPYCLON^IBCECOB2(+$G(IBDAX(IBDAX)),IB364,.IBDAX)
103CLONEQ S VALMBCK="R"
104 Q
105 ;
106PRO ; Copy for secondary/tertiary bill
107 N IBIFNH,IBIFN,IB364,IBX,IBA,Z,IBCBASK,IBCBCOPY,IBCAN
108 D FULL^VALM1
109 ;IBDAX - array from selection of message
110 S IBA=$G(IBDAX(+$G(IBDAX)))
111 G:'IBA PROQ
112 S IBX=$G(^TMP("IBCECSB",$J,$P(IBA,U,3),$P(IBA,U,4),$P(IBA,U,6),$P(IBA,U,2))),IBIFN=$P(IBA,U)
113 S IB364=+$P(IBA,U,5)
114 G:'IBIFN PROQ
115 ;
116 I $P($G(^DGCR(399,IBIFN,0)),U,13)=2 D G PROQ
117 . W !!?4,"This bill is in a status of REQUEST MRA."
118 . I $$CHK^IBCEMU1(IBIFN) W !?4,"MRA EOBs must be processed from the MRA management worklist."
119 . E W !?4,"There are no MRA EOBs on file."
120 . D PAUSE^VALM1
121 . Q
122 ;
123 D COBCOPY^IBCECOB2(IBIFN,IB364,1,$P(IBA,U,2),"INIT^IBCECSA2")
124PROQ S VALMBCK="R"
125 Q
126 ;
127RES ;Resubmit bill by print
128 N IBTMP,IB364,IBIFN,IBX,IBA
129 D FULL^VALM1
130 S (IBTMP,IBDAX)=$O(IBDAX(0)),IBTMP(IBTMP)=IBDAX(IBDAX)
131 S IBIFN=$P($G(IBDAX(+IBDAX)),U)
132 S IB364=+$P($G(IBDAX(IBDAX)),U,5)
133 I IBIFN D PRINT1^IBCEM03(IBIFN,.IBDAX,IB364),PAUSE^VALM1,INIT^IBCECSA2
134 S IBDAX(IBTMP)=IBTMP(IBTMP)
135 S VALMBCK="R"
136 Q
137 ;
138EBI ;Edit bill
139 N IBFLG,IBIFN,IB364,IBX,IBA
140 K ^TMP($J,"IBBILL")
141 D FULL^VALM1
142 S IBDAX=$O(IBDAX(""))
143 I IBDAX="" G EDITQ
144 S IBIFN=$P(IBDAX(IBDAX),U)
145 S IBFLG=1 D I IBFLG S IBDAX="" D PAUSE^VALM1 G EDITQ
146 . I $P($G(^DGCR(399,IBIFN,0)),U,13)>2 W !,*7,"An authorized bill can not be edited." Q
147 . I '$D(^XUSEC("IB EDIT",DUZ)) W !,*7,"You are not authorized to edit a bill" Q
148 . S IBFLG=0
149 S IBIFN=+$G(IBDAX(IBDAX))
150 S IB364=+$P($G(IBDAX(IBDAX)),U,5)
151 D EBILL^IBCEM3(.IBDAX,IBIFN,IB364)
152EDITQ S VALMBCK="R"
153 Q
154 ;
155SEL(IBDA,ONE) ; Select entry(s) from list
156 ; IBDA = array returned if selections made
157 ; IBDAX(n)=ien of bill selected (file 399)
158 ; ONE = if set to 1, only one selection can be made at a time
159 N IB
160 K IBDA
161 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
162 S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA D
163 . S IBDA(IBDA)=$P($G(^TMP("IBCECSA",$J,IBDA)),U,2,7)
164 Q
165 ;
166RESUB(IBIFN,TXMT,IBFUNC,IBTBA) ; Function asks if resubmit as resolution to a
167 ; message is the intention
168 ; IBIFN = ien of bill in file 399
169 ; TXMT = flag if = 1, assume it's transmittable, don't have to check
170 ; IBFUNC = code to say where the code is called from
171 ; 'E'=edit/authorize 'P'=print 'PX'= print/not to resubmit 'C'=cancel
172 ; IBTBA = transmit bill array returned to calling routine. Optional
173 ; parameter to be passed by reference.
174 ; IBTBA(364ptr)=""
175 ;
176 ; Returns:
177 ; -1 = ^ or timeout at prompt
178 ; 0 = not a transmittable bill or review not needed
179 ; 1 = don't update the review status (user choice)
180 ; 2 = Yes, update the review status (user choice), or resubmit by print
181 ;
182 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,STAT
183 KILL IBTBA
184 I '$G(TXMT),'$$TXMT^IBCEF4(IBIFN) S Y=0 G RESUB1 ; not transmittable
185 ;
186 ; Check for any messages or EOB's needing review
187 S STAT=$$STATUS^IBCEF4(IBIFN)
188 I '$TR(STAT,U) S Y=0 G RESUB1 ; no unreviewed items
189 I $P(STAT,U,1) S IBTBA($P(STAT,U,1))="" ; 364 ien for 361 data
190 I $P(STAT,U,2) S IBTBA($P(STAT,U,2))="" ; 364 ien for 361.1 data
191 ;
192 I IBFUNC'="P" D
193 . S DIR(0)="YA",DIR("A",1)="",DIR("A",2)="This bill is in need of review due to receipt of a status msg or EOB",DIR("A")="OK to update the review status to 'REVIEW COMPLETE' based on this action?: ",DIR("B")="NO"
194 . S DIR("?",1)="You have just "_$S(IBFUNC="E":"requested re-transmission of",IBFUNC="C":"cancelled",1:"")_" the bill"
195 . S DIR("?",2)="You can update the review status of the unreviewed message to ",DIR("?",3)=" 'REVIEW COMPLETE' if you say YES here"
196 . S DIR("?")="Press ENTER to continue "
197 . D ^DIR K DIR
198 . I $D(DTOUT)!$D(DUOUT) S Y=-1 Q
199 . S Y=Y+1
200 E D
201 . W !,"The review status of this message will be updated to 'REVIEW COMPLETE'",!," based on this action"
202 . S Y=2
203 ;
204RESUB1 Q +Y
205 ;
206RETXMT ;
207 N IB364,IBIFN
208 D FULL^VALM1
209 S IBDAX=$O(IBDAX(0)),IB364=+$P($G(IBDAX(IBDAX)),U,5),IBIFN=+$P($G(IBDAX(IBDAX)),U)
210 I 'IB364!('IBIFN) G RETXMTQ
211 D MRACHK I MRACHK G RETXMTQ
212 D RESUB^IBCE(IB364)
213RETXMTQ S VALMBCK="R"
214 Q
215 ;
216MRACHK ; Restrict access to process REQUEST MRA claims
217 S MRACHK=0
218 ; At least one MRA EOB appears on the MRA management worklist
219 I $P($G(^DGCR(399,IBIFN,0)),U,13)=2,$$MRAWL^IBCEMU2(IBIFN) S MRACHK=1 D D PAUSE^VALM1
220 . W !,?4,"This bill is in a status of REQUEST MRA and it does appear on"
221 . W !,?4,"the MRA Management Worklist. Please use the MRA Management Menu"
222 . W !,?4,"options for all processing related to this bill."
223 Q
Note: See TracBrowser for help on using the repository browser.