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

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

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