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

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

initial load of FOIAVistA 6/30/08 version

File size: 7.8 KB
Line 
1IBCEDS ;ALB/ESG - EDI CLAIM STATUS REPORT - SELECTION ;13-DEC-2007
2 ;;2.0;INTEGRATED BILLING;**377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7EN ; entry point
8 ;
9 NEW STOP,IBMETHOD,IBSORT1,IBSORT2,IBSORT3,IBSORTOR
10 S STOP=0
11 K ^TMP($J,"IBCEDS")
12 W @IOF,!,"EDI Claim Status Report"
13 ;
14DS10 D CLAIM I STOP G:$$STOP EX G DS10
15 I IBMETHOD="C" G DS70 ; skip down to the Sort questions
16DS20 D DIV I STOP G:$$STOP EX G DS10
17DS30 D PAYER I STOP G:$$STOP EX G DS20
18DS40 D TXDATE I STOP G:$$STOP EX G DS30
19DS50 D EDISTAT I STOP G:$$STOP EX G DS40
20DS60 D CANCEL I STOP G:$$STOP EX G DS50
21DS70 D SORT I STOP G:$$STOP EX G:IBMETHOD="C" DS10 G DS60
22DS80 D DEVICE I STOP G:$$STOP EX G DS70
23 ;
24EX ; exit point
25 Q
26 ;
27STOP() ; Determine if user wants to exit out of the whole option
28 ; 1=yes, get out entirely
29 ; 0=no, just go back to the previous question
30 N DIR,X,Y,DIRUT
31 ;
32 W !
33 S DIR(0)="Y"
34 S DIR("A")="Do you want to exit out of this option entirely"
35 S DIR("B")="YES"
36 S DIR("?",1)=" Enter YES to immediately exit out of this option."
37 S DIR("?")=" Enter NO to return to the previous question."
38 D ^DIR K DIR
39 I $D(DIRUT) S (STOP,Y)=1 G STOPX
40 I 'Y S STOP=0
41 ;
42STOPX ; STOP exit pt
43 Q Y
44 ;
45CLAIM ; enter in multiple claim#'s or generate a report
46 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,Z
47CLM1 ;
48 W !!,"CLAIM SELECTION METHOD"
49 K ^TMP($J,"IBCEDS","CLAIM") S IBMETHOD=""
50 S DIR(0)="SA^C:Select Specific Claims;R:Regular Selection Criteria"
51 S DIR("A")="Method to Select Claims: "
52 S DIR("B")="Regular Selection Criteria"
53 D ^DIR K DIR
54 I $D(DIRUT) S STOP=1 G CLAIMX
55 S IBMETHOD=Y
56 I IBMETHOD="R" K ^TMP($J,"IBCEDS","CLAIM") G CLAIMX ; regular selection method
57 ;
58 ; select specific claims
59 ;
60 W !
61 S IBDONE=0
62 F D Q:IBDONE!STOP
63 . S DIR(0)="PAO^364:AEMQZ"
64 . S DIR("S")="I '$O(^IBA(364,""B"",+$G(^(0)),Y))" ; prevent multiple 364 entries from listing
65 . S DIR("A")=" Select a Claim: "
66 . I $O(^TMP($J,"IBCEDS","CLAIM","")) S DIR("A")=" Select Another Claim: "
67 . D ^DIR K DIR
68 . I $D(DUOUT)!$D(DTOUT) S STOP=1 Q ; up arrow or timeout
69 . I +Y'>0 S IBDONE=1 Q ; null response
70 . S Z=$G(^IBA(364,+Y,0))
71 . I $P(Z,U,7) W *7,!!?3,"Test Claim Transmissions are not Allowed.",! Q
72 . I $P(Z,U,3)="X" W *7,!!?3,"This Claim is still in a READY FOR EXTRACT status.",! Q
73 . I '$P(Z,U,2) W *7,!!?3,"This Claim has no Batch#.",! Q
74 . I '$P(Z,U,1) W *7,!!?3,"This Claim is Corrupted.",! Q
75 . ;
76 . S ^TMP($J,"IBCEDS","CLAIM",+Z)=+Y
77 . Q
78 ;
79 I STOP G CLAIMX
80 ;
81 I '$O(^TMP($J,"IBCEDS","CLAIM","")) D G CLM1
82 . W *7,!!?3,"No claims have been selected. Please try again."
83 . Q
84 ;
85CLAIMX ;
86 Q
87 ;
88DIV ; division selection
89 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,DIC
90DV1 ;
91 K ^TMP($J,"IBCEDS","DIV")
92 W !!,"DIVISION SELECTION"
93 S DIR(0)="SA^A:All Divisions;S:Selected Divisions"
94 S DIR("A")="Include All Divisions or Selected Divisions? "
95 S DIR("B")="All Divisions"
96 D ^DIR K DIR
97 I $D(DIRUT) S STOP=1 G DIVX
98 I Y="A" K ^TMP($J,"IBCEDS","DIV") G DIVX
99 ;
100 W !
101 S IBDONE=0
102 F D Q:IBDONE!STOP
103 . S DIC=40.8,DIC(0)="AEMQ",DIC("A")=" Select Division: "
104 . I $O(^TMP($J,"IBCEDS","DIV","")) S DIC("A")=" Select Another Division: "
105 . D ^DIC K DIC ; lookup
106 . I $D(DUOUT)!$D(DTOUT) S STOP=1 Q ; up arrow or timeout
107 . I +Y'>0 S IBDONE=1 Q ; user is done
108 . S ^TMP($J,"IBCEDS","DIV",+Y)=$P(Y,U,2)
109 . Q
110 ;
111 I STOP G DIVX
112 ;
113 I '$O(^TMP($J,"IBCEDS","DIV","")) D G DV1
114 . W *7,!!?3,"No divisions have been selected. Please try again."
115 . Q
116 ;
117DIVX ;
118 Q
119 ;
120PAYER ; payer selection
121 NEW IBPAYER,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,DIC,EDI,PROF,INST
122PY1 ;
123 K ^TMP($J,"IBCEDS","INS")
124 W !!,"PAYER SELECTION"
125 S IBPAYER=""
126 S DIR(0)="SA^A:All Payers;S:Selected Payers"
127 S DIR("A")="Include All Payers or Selected Payers? "
128 S DIR("B")="All Payers"
129 D ^DIR K DIR
130 I $D(DIRUT) S STOP=1 G PAYERX
131 I Y="A" K ^TMP($J,"IBCEDS","INS") G PAYERX
132 W !
133 S DIR(0)="Y"
134 S DIR("A")=" Include all payers with the same electronic Payer ID"
135 S DIR("B")="Yes"
136 D ^DIR K DIR
137 I $D(DIRUT) S STOP=1 G PAYERX
138 S IBPAYER=Y
139 W !
140 ;
141 S IBDONE=0
142 F D Q:IBDONE!STOP
143 . S DIC=36,DIC(0)="AEMQ",DIC("A")=" Select Insurance Company: "
144 . I $O(^TMP($J,"IBCEDS","INS",1,"")) S DIC("A")=" Select Another Insurance Company: "
145 . S DIC("W")="D INSLIST^IBCEMCA(Y)"
146 . D ^DIC K DIC ; lookup
147 . I $D(DUOUT)!$D(DTOUT) S STOP=1 Q ; up arrow or timeout
148 . I +Y'>0 S IBDONE=1 Q ; user is done
149 . S ^TMP($J,"IBCEDS","INS",1,+Y)=$P(Y,U,2)
150 . I 'IBPAYER Q
151 . S EDI=$$UP^XLFSTR($G(^DIC(36,+Y,3)))
152 . S PROF=$P(EDI,U,2)
153 . S INST=$P(EDI,U,4)
154 . I PROF'="",PROF'["PRNT" S ^TMP($J,"IBCEDS","INS",2,PROF,+Y)=""
155 . I INST'="",INST'["PRNT" S ^TMP($J,"IBCEDS","INS",2,INST,+Y)=""
156 . Q
157 ;
158 I STOP G PAYERX
159 ;
160 I '$O(^TMP($J,"IBCEDS","INS",1,"")) D G PY1
161 . W *7,!!?3,"No payers have been selected. Please try again."
162 . Q
163 ;
164PAYERX ;
165 Q
166 ;
167TXDATE ; date range for the last transmission date
168 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,TDEF
169 K ^TMP($J,"IBCEDS","ALTDT")
170 W !!,"LAST TRANSMIT DATE RANGE SELECTION"
171 S DIR(0)="DAO^:"_DT_":AEX"
172 S DIR("A")=" Start with Date Last Transmitted: "
173 S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-14),"5Z")
174 D ^DIR K DIR
175 I $D(DIRUT)!'Y S STOP=1 G TXDATEX
176 S $P(^TMP($J,"IBCEDS","ALTDT"),U,1)=Y
177 ;
178 S DIR(0)="DAO^"_Y_":"_DT_":AEX"
179 S DIR("A")=" Go to Date Last Transmitted: "
180 S TDEF=$$FMADD^XLFDT(DT,-7) ; normal to date default
181 I TDEF'>Y S TDEF=DT ; if to date default is on or before from date, set default=today
182 S DIR("B")=$$FMTE^XLFDT(TDEF,"5Z")
183 D ^DIR K DIR
184 I $D(DIRUT)!'Y S STOP=1 G TXDATEX
185 S $P(^TMP($J,"IBCEDS","ALTDT"),U,2)=Y
186TXDATEX ;
187 Q
188 ;
189EDISTAT ; selection of one or all of the EDI claim statuses
190 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,EDILST
191EDI1 ;
192 W !!,"EDI CLAIM STATUS SELECTION"
193 K ^TMP($J,"IBCEDS","EDI")
194 S DIR(0)="SA^A:All EDI Statuses;S:Selected EDI Statuses"
195 S DIR("A")="Include All EDI Statuses or Selected EDI Statuses? "
196 S DIR("B")="Selected EDI Statuses"
197 D ^DIR K DIR
198 I $D(DIRUT) S STOP=1 G EDISTATX
199 I Y="A" K ^TMP($J,"IBCEDS","EDI") G EDISTATX
200 ;
201 W !
202 K EDILST D FIELD^DID(364,.03,,"POINTER","EDILST")
203 S IBDONE=0
204 F D Q:IBDONE!STOP
205 . S DIR(0)="364,.03AO"
206 . I $G(EDILST("POINTER"))'="" S DIR(0)="SAO^"_EDILST("POINTER")
207 . S DIR("A")=" Select Status: "
208 . I $O(^TMP($J,"IBCEDS","EDI",""))'="" S DIR("A")=" Select Another Status: "
209 . I $O(^TMP($J,"IBCEDS","EDI",""))="" S DIR("B")="RECEIVED IN AUSTIN"
210 . D ^DIR K DIR
211 . I $D(DUOUT)!$D(DTOUT) S STOP=1 Q ; up arrow or timeout
212 . I Y="" S IBDONE=1 Q
213 . S ^TMP($J,"IBCEDS","EDI",Y)=$G(Y(0))
214 . Q
215 ;
216 I STOP G EDISTATX
217 ;
218 I $O(^TMP($J,"IBCEDS","EDI",""))="" D G EDI1
219 . W *7,!!?3,"No EDI statuses have been selected. Please try again."
220 . Q
221 ;
222EDISTATX ;
223 Q
224 ;
225CANCEL ; Include cancelled claims?
226 W !!,"CANCELLED CLAIM SELECTION"
227 K ^TMP($J,"IBCEDS","CANCEL")
228 S DIR(0)="Y"
229 S DIR("A")="Include Cancelled Claims"
230 S DIR("B")="YES"
231 S DIR("?",1)=" Enter No to omit claims that have been cancelled in IB and/or AR."
232 S DIR("?")=" Enter Yes to include claims that have been cancelled in IB and/or AR."
233 D ^DIR K DIR
234 I $D(DIRUT) S STOP=1 G CANCELX
235 S ^TMP($J,"IBCEDS","CANCEL")=Y
236CANCELX ;
237 Q
238 ;
239SORT ; Gather the primary, secondary, and tert sorts
240 W @IOF
241 W !!,"SORT CRITERIA"
242 K IBSORTOR
243 D SORTSEL^IBCEDS1(1) I STOP G SORTX
244 D SORTSEL^IBCEDS1(2) I STOP G SORTX
245 I $G(IBSORT2)'="" D SORTSEL^IBCEDS1(3) I STOP G SORTX
246SORTX ;
247 Q
248 ;
249DEVICE ; Device selection
250 NEW ZTRTN,ZTDESC,ZTSAVE,POP
251 W !!!,"This report is 132 characters wide. Please choose an appropriate device.",!
252 S ZTRTN="EN^IBCEDC"
253 S ZTDESC="COMPILE/PRINT EDI CLAIM STATUS DETAIL REPORT"
254 S ZTSAVE("IBMETHOD")=""
255 S ZTSAVE("IBSORT1")=""
256 S ZTSAVE("IBSORT2")=""
257 S ZTSAVE("IBSORT3")=""
258 S ZTSAVE("IBSORTOR")=""
259 S ZTSAVE("^TMP($J,""IBCEDS"",")=""
260 D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
261 I POP S STOP=1
262DEVICEX ;
263 Q
264 ;
Note: See TracBrowser for help on using the repository browser.