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

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

initial load of WorldVistAEHR

File size: 7.4 KB
Line 
1IBCEPTC3 ;ALB/ESG - EDI PREVIOUSLY TRANSMITTED CLAIMS ACTIONS ;12/19/05
2 ;;2.0;INTEGRATED BILLING;**320**;21-MAR-94
3 ;
4 Q
5 ;
6SELECT ; Select claims to resubmit
7 N IBIFN,IBZ,IBI,IBQ,DIR,VALMY,X,Y
8 D FULL^VALM1
9 D EN^VALM2($G(XQORNOD(0)))
10 S IBZ=0 F S IBZ=$O(VALMY(IBZ)) Q:'IBZ D
11 . S IBQ=$G(^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBZ)),IBI=+$P(IBQ,U,2),IBQ=+IBQ
12 . S IBIFN=+$G(^IBA(364,IBI,0))
13 . Q:'IBIFN
14 . D MARK(IBIFN,IBZ,IBQ,IBI,1,.VALMHDR)
15 S VALMBCK="R"
16 Q
17 ;
18SELBATCH ; Select a batch to resubmit
19 ; Assumes IBSORT is defined
20 N DIC,DIR,X,Y,Z,IBQ,IBZ,IBI,IBDX,IBASK,IBOK,IBY,DTOUT,DUOUT
21 D FULL^VALM1
22 I IBSORT'=1 D G SELBQ
23 . S DIR(0)="EA",DIR("A",1)="This action is not available unless you chose to sort by batch",DIR("A")="Press return to continue: "
24 . W ! D ^DIR K DIR
25 S DIC="^IBA(364.1,",DIC(0)="AEMQ",DIC("S")="I $D(^TMP(""IB_PREV_CLAIM_BATCH"",$J,+Y))"
26 D ^DIC K DIC
27 I Y'>0 G SELBQ
28 S IBY=+Y,VALMBG=+$G(^TMP("IB_PREV_CLAIM_BATCH",$J,IBY))
29 ;
30 S (IBOK,IBASK)=1
31 I $G(^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,"SEL")) D G:'IBOK SELBQ
32 . S DIR(0)="YA",DIR("A",1)="This batch was previously selected.",DIR("A")="Do you want to de-select all claims in this batch?: ",DIR("B")="No"
33 . W ! D ^DIR K DIR
34 . I $D(DTOUT)!$D(DUOUT) S IBOK=0 Q
35 . I Y S IBASK=0 K ^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,"SEL")
36 ;
37 S IBQ=0 ; last screen row# for claim
38 F S IBQ=$O(^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,IBQ)) Q:'IBQ D
39 . S IBZ=$G(^(IBQ)) ; IBIFN^selection#
40 . S Z=$P(IBZ,U,2) ; selection#
41 . S IBDX=$G(^TMP("IB_PREV_CLAIM_LIST_DX",$J,+Z)) ; 1st screen row# for claim^364 ien
42 . S IBI=$P(IBDX,U,2) ; 364 ien
43 . D MARK(+IBZ,Z,+IBDX,IBI,IBASK,.VALMHDR)
44 ;
45 I IBASK S ^TMP("IB_PREV_CLAIM_BATCH",$J,IBY,"SEL")=1
46 ;
47SELBQ S VALMBCK="R"
48 Q
49 ;
50MARK(IBIFN,IBZ,IBQ,IBI,IBASK,VALMHDR) ; Mark claim as selected for resubmit
51 ; Returns VALMHDR killed if any selections/de-selections made
52 N DIR,X,Y
53 I $D(^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN)) D Q
54 . S Y=1
55 . I IBASK D
56 .. S DIR(0)="YA",DIR("B")="No",DIR("A",1)="Claim "_$P($G(^DGCR(399,IBIFN,0)),U)_" for entry # "_IBZ_" has already been selected",DIR("A")="Do you want to de-select it?: " W ! D ^DIR K DIR
57 . I Y=1 K ^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN) S $E(^TMP("IB_PREV_CLAIM_LIST",$J,IBQ,0),6)=" ",^TMP("IB_PREV_CLAIM_SELECT",$J)=^TMP("IB_PREV_CLAIM_SELECT",$J)-1 K VALMHDR
58 ;
59 S ^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN)=IBQ,^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN,0)=IBI,^TMP("IB_PREV_CLAIM_SELECT",$J)=$G(^TMP("IB_PREV_CLAIM_SELECT",$J))+1
60 S $E(^TMP("IB_PREV_CLAIM_LIST",$J,IBQ,0),6)="*" K VALMHDR
61 Q
62 ;
63VIEW ; View claims selected
64 N IBCT,IBQUIT,DIR,X,Y,Z,Z0
65 D FULL^VALM1
66 I '$O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) D G VIEWQ
67 . S DIR(0)="EA",DIR("A")="No claims have been selected - Press return to continue " D ^DIR K DIR
68 W @IOF
69 S (IBQUIT,IBCT)=0
70 W !,+^TMP("IB_PREV_CLAIM_SELECT",$J)," claims selected:"
71 S Z="" F S Z=$O(^TMP("IB_PREV_CLAIM_SELECT",$J,Z)) Q:'Z S Z0=+$G(^(Z)) D
72 . Q:'$D(^TMP("IB_PREV_CLAIM_LIST",$J,Z0,0))
73 . S IBCT=IBCT+1
74 . I '(IBCT#15) S IBQUIT=0 D Q:IBQUIT
75 .. S DIR(0)="E" D ^DIR K DIR
76 .. I 'Y S IBQUIT=1
77 . W !," ",$E(^TMP("IB_PREV_CLAIM_LIST",$J,Z0,0),7,47)
78 ;
79 G:IBQUIT VIEWQ
80 S DIR(0)="E" D ^DIR K DIR
81 ;
82VIEWQ S VALMBCK="R"
83 Q
84 ;
85RESUB ; Resubmit selected claims
86 N DIR,X,Y,IBIFN,IB364,Z1,IBTYPPTC,DIRUT,DIROUT,DTOUT,DUOUT,IBFSKIP,IBABORT
87 D FULL^VALM1
88 I '$O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) D G RESUBQ
89 . N DIR,X,Y
90 . S DIR(0)="EA",DIR("A")="No claims have been selected - Press return to continue " D ^DIR K DIR
91 ;
92 ; Ask user if resubmit as production or as test
93 S DIR(0)="SA^P:Production;T:Test Only"
94 S DIR("A")="Resubmit Claims: "
95 S DIR("B")="Production"
96 S DIR("?",1)=" Select Production to resubmit the claims to the payer for payment."
97 S DIR("?")=" Select Test to resubmit the claims as Test claims only."
98 W ! D ^DIR K DIR
99 I $D(DIRUT) G RESUBQ
100 S IBTYPPTC="TEST"
101 I Y="P" S IBTYPPTC="PRODUCTION"
102 ;
103 S DIR(0)="YA",DIR("B")="No"
104 S DIR("A",1)="You are about to resubmit "_+^TMP("IB_PREV_CLAIM_SELECT",$J)_" claims as "_IBTYPPTC_" claims."
105 S DIR("A")="Are you sure you want to continue?: "
106 W ! D ^DIR K DIR
107 I Y'=1 G RESUBQ
108 ;
109 ; OK to proceed and resubmit
110 W !!,"Resubmission in process ... "
111 ;
112 ; loop thru selected claims and set into scratch globals
113 S IBFSKIP=0
114 KILL ^TMP("IBRCBOLD",$J)
115 S IBIFN=0 F S IBIFN=$O(^TMP("IB_PREV_CLAIM_SELECT",$J,IBIFN)) Q:'IBIFN S Z1=+$G(^(IBIFN)),IB364=+$G(^(IBIFN,0)) I IB364 D
116 . ;
117 . I IBTYPPTC="TEST" D
118 .. S ^TMP("IBEDI_TEST_BATCH",$J,IB364)=""
119 .. S ^TMP("IBRESUBMIT",$J,IB364)=""
120 .. I Z1 D MARK(IBIFN,"",Z1,IB364,0,.VALMHDR)
121 .. Q
122 . ;
123 . I IBTYPPTC="PRODUCTION" D
124 .. I '$$TXOK(IBIFN) S IBFSKIP=IBFSKIP+1 Q ; transmission not allowed
125 .. N Y S Y=$$ADDTBILL^IBCB1(IBIFN) ; new entry in file 364 - "X" status
126 .. I '$P(Y,U,3) Q ; quit if new entry didn't get added
127 .. S ^TMP("IBSELX",$J,+Y)=""
128 .. S ^TMP("IBRCBOLD",$J,IB364)="" ; save list of old transmit bills
129 .. I Z1 D MARK(IBIFN,"",Z1,IB364,0,.VALMHDR)
130 .. Q
131 . ;
132 . Q
133 ;
134 ; set top level of scratch globals based on test or production
135 I IBTYPPTC="TEST" S ^TMP("IBRESUBMIT",$J)="^^0^1",^TMP("IBEDI_TEST_BATCH",$J)=1
136 E KILL ^TMP("IBRESUBMIT",$J),^TMP("IBEDI_TEST_BATCH",$J),^TMP("IBONE",$J) S ^TMP("IBSELX",$J)=0
137 ;
138 ; resubmit call
139 D EN1^IBCE837B("","","",.IBABORT)
140 ;
141 ; if user aborted at the last minute, then get rid of the new entries
142 ; in file 364 that were added for production claim sending
143 I IBABORT D
144 . N IB,DIK,DA
145 . S IB=0 F S IB=$O(^TMP("IBSELX",$J,IB)) Q:'IB S DIK="^IBA(364,",DA=IB D ^DIK
146 . Q
147 ;
148 ; update EDI files for the old transmit bills
149 I 'IBABORT D
150 . N IB
151 . S IB=0 F S IB=$O(^TMP("IBRCBOLD",$J,IB)) Q:'IB D UPDEDI^IBCEM(IB,"R")
152 . Q
153 ;
154 ; cleanup
155 K ^TMP("IBEDI_TEST_BATCH",$J),^TMP("IBRESUBMIT",$J),^TMP("IBSELX",$J),^TMP("IBRCBOLD",$J)
156 I '$O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) K ^TMP("IB_PREV_CLAIM_SELECT",$J)
157 S DIR(0)="EA"
158 S DIR("A",1)="Selected claims have been resubmitted as "_IBTYPPTC_"."
159 I IBFSKIP D
160 . S DIR("A",2)="Please note: Some claims were not eligible to be resubmitted as live claims."
161 . S DIR("A",3)=" These claims are still indicated as being selected."
162 . Q
163 I IBABORT K DIR("A") S DIR("A",1)="No claims were resubmitted."
164 S DIR("A")="Press return to continue "
165 W ! D ^DIR K DIR
166 K VALMHDR
167 ;
168RESUBQ ;
169 S VALMBCK="R"
170 Q
171 ;
172REPORT ; Print report
173 ; Assumes IBSORT, IBDT1, IBDT2 defined
174 N IBACT,Z
175 D FULL^VALM1
176 F S IBACT=0 D DEVSEL^IBCEPTC(.IBACT) Q:IBACT
177 I IBACT'=99 D
178 . N IBREP
179 . S IBREP="R" D RPT^IBCEPTC1(IBSORT,IBDT1,IBDT2)
180 ;
181 D HOME^%ZIS
182 S VALMBCK="R"
183 Q
184 ;
185CKSENT(VALMBCK) ; Make sure selected entries are transmitted
186 ;
187 N IBOK,DIR,X,Y
188 S IBOK=1
189 I $O(^TMP("IB_PREV_CLAIM_SELECT",$J,0)) D
190 . D FULL^VALM1
191 . S DIR(0)="YA",DIR("A",1)="You have selected "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" claims, but have not resubmitted them",DIR("A")="Are you sure you want to quit before you resubmit them?: ",DIR("B")="No"
192 . W ! D ^DIR K DIR
193 . I Y'=1 S VALMBCK="R",IBOK=0
194 I IBOK S VALMBCK="Q"
195 Q
196 ;
197TXOK(IBIFN) ; Function determines if claim is OK for live resubmission
198 NEW OK,IB364,IBD,IBSTAT
199 S OK=0
200 I '$P($G(^DGCR(399,+$G(IBIFN),"TX")),U,2) G TXOKX ; last electronic extract date
201 I '$F(".2.3.4.","."_$P($G(^DGCR(399,IBIFN,0)),U,13)_".") G TXOKX ; claim status
202 S IB364=+$$LAST364^IBCEF4(+$G(IBIFN)) I 'IB364 G TXOKX ; transmit bill exists
203 S IBD=$G(^IBA(364,IB364,0)) I IBD="" G TXOKX
204 S IBSTAT=$P(IBD,U,3) I IBSTAT="X" G TXOKX ; already awaiting extract
205 S OK=1
206TXOKX ;
207 Q OK
208 ;
Note: See TracBrowser for help on using the repository browser.