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

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

initial load of WorldVistAEHR
File size: 8.4 KB
Line 
1IBCNSGE ;ALB/ESG - Insurance Company EDI Parameter Report ;07-JAN-2005
2 ;;2.0;INTEGRATED BILLING;**296**;21-MAR-94
3 ;
4 ; eClaims Plus
5 ; Identify insurance companies and display EDI parameter information.
6 ;
7 ;
8EN ; Entry Point
9 NEW IBRINS,IBRBID,IBRINS1,IBRINS2,IBRSORT,STOP
10 D SELECT I STOP G EXIT
11 D SORT I STOP G EXIT
12 D DEVICE
13EXIT ;
14 Q
15 ;
16SELECT ; Select insurance companies to include on the report
17 NEW DIR,DIC,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBQ
18SEL1 ;
19 S STOP=0,IBQ=0
20 W @IOF
21 W !!?21,"Insurance Company EDI Parameter Report"
22 W !!?5,"This report will display the EDI parameter information for selected"
23 W !?5,"insurance companies. You can specify one company, multiple companies,"
24 W !?5,"a range of company names, or all companies on file."
25 ;
26 S DIR(0)="SO^A:Include All Insurance Companies;S:Select Specific Insurance Companies;R:Specify a Range of Insurance Company Names"
27 S DIR("A")=" Method for selecting insurance companies"
28 S DIR("B")="A"
29 S DIR("?",1)="Enter a code from the list. This defines how you want to select insurance"
30 S DIR("?",2)="companies for this report."
31 S DIR("?",3)=""
32 S DIR("?",4)="If you choose 'A', then all active companies will be included."
33 S DIR("?",5)="If you choose 'S', then one or more specific companies can be selected."
34 S DIR("?")="If you choose 'R', then you can enter a range of company names."
35 D ^DIR K DIR
36 I $D(DIRUT) S STOP=1 G SELX
37 S IBRINS=Y
38 I '$F(".A.S.R.","."_IBRINS_".") S STOP=1 G SELX
39 I IBRINS="S" D MULT I IBQ G SEL1 ; choose one or many
40 I IBRINS="R" D RANGE I IBQ G SEL1 ; choose a range
41 ;
42 W !
43 S DIR(0)="YO"
44 S DIR("A",1)="Only include Insurance Companies with Electronic"
45 S DIR("A")=" Bill ID's that are blank or contain ""PRNT"""
46 S DIR("B")="NO"
47 S DIR("?",1)="Enter either 'Y' or 'N'. If you choose 'Y', then this will limit the selection"
48 S DIR("?",2)="of insurance companies. Only those companies in which the Inst ID or the Prof"
49 S DIR("?",3)="ID is either blank or contains ""PRNT"" (uppercase or lowercase)"
50 S DIR("?")="will be included."
51 D ^DIR K DIR
52 I $D(DIRUT) S STOP=1 G SELX
53 S IBRBID=Y
54SELX ;
55 Q
56 ;
57MULT ; select one or many insurance companies
58 NEW DIC,X,Y
59 K IBRINS S IBRINS="S"
60 F D Q:Y'>0
61 . W ! S DIC("A")="Insurance Company: "
62 . S DIC("S")="I $$ACTIVE^IBCNEUT4(Y)" ; screen out Inactives
63 . S DIC=36,DIC(0)="AEQM" D ^DIC
64 . Q:Y'>0
65 . S IBRINS(+Y)=$P($G(^DIC(36,+Y,0)),U,1)
66 . Q
67 I $O(IBRINS(""))="" S IBQ=1 G MULTX ; none selected
68MULTX ;
69 Q
70 ;
71RANGE ; select a range of insurance company names
72 K IBRINS1,IBRINS2
73 W !
74 S DIR(0)="FO",DIR("A")="Start with Insurance Company"
75 S DIR("?",1)="This response can be free text."
76 S DIR("?",2)="Responses are case sensitive."
77 S DIR("?")="Example: To find CIGNA, type CIGNA not cigna or Cigna."
78 S DIR("B")="First" D ^DIR K DIR
79 I $D(DIRUT) S IBQ=1 G RANGEX
80 S IBRINS1=Y
81 I IBRINS1="First" S IBRINS1=" "
82 ;
83 W !
84 S DIR(0)="FO",DIR("A")="Go to Insurance Company"
85 S DIR("?",1)="This response can be free text."
86 S DIR("?",2)="Responses are case sensitive."
87 S DIR("?")="Example: To find CIGNA, type CIGNA not cigna or Cigna."
88 S DIR("B")="Last" D ^DIR K DIR
89 I $D(DIRUT) S IBQ=1 G RANGEX
90 S IBRINS2=Y
91 I IBRINS2="Last" S IBRINS2="~~~~~"
92 ;
93 I IBRINS1=" ",IBRINS2="~~~~~" D G RANGEX
94 . K IBRINS,IBRINS1,IBRINS2
95 . S IBRINS="A"
96 . Q
97 ;
98 I IBRINS1]IBRINS2 D G RANGE
99 . W !!?5,"Sorry ..... Ending name must come after Starting name"
100 . W !!?5,"Please try again",*7
101 . Q
102 ;
103RANGEX ;
104 Q
105 ;
106SORT ; Choose the sorting method
107 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
108 W !!?5,"*** Sort Criteria ***"
109 S DIR(0)="SO^1:Insurance Company Name;2:Prof Electronic Bill ID;3:Inst Electronic Bill ID;4:Electronic Type;5:Type Of Coverage"
110 S DIR("A")="Sort By",DIR("B")=1
111 D ^DIR K DIR
112 I $D(DIRUT) S STOP=1 G SORTX
113 S IBRSORT=Y
114SORTX ;
115 Q
116 ;
117COMPILE ; Entry point for task; compile scratch global, print, clean-up
118 ;
119 NEW RTN,INSIEN,INSNM,DATA,ADDR,EDI,PROFID,INSTID,NAME,STREET,CITY
120 NEW STATE,TYPCOV,TRANS,INSTYP,SORT,TMP
121 ;
122 S RTN="IBCNSGE"
123 KILL ^TMP($J,RTN) ; init
124 ;
125 ; all insurances
126 I IBRINS="A" D
127 . S INSIEN=0
128 . F S INSIEN=$O(^DIC(36,INSIEN)) Q:'INSIEN D CALC(INSIEN)
129 . Q
130 ;
131 ; specific insurances
132 I IBRINS="S" D
133 . S INSIEN=0
134 . F S INSIEN=$O(IBRINS(INSIEN)) Q:'INSIEN D CALC(INSIEN)
135 . Q
136 ;
137 ; a range of insurances
138 I IBRINS="R" D
139 . S INSNM=$O(^DIC(36,"B",IBRINS1),-1)
140 . F S INSNM=$O(^DIC(36,"B",INSNM)) Q:INSNM="" Q:INSNM]IBRINS2 D
141 .. S INSIEN=0
142 .. F S INSIEN=$O(^DIC(36,"B",INSNM,INSIEN)) Q:'INSIEN D CALC(INSIEN)
143 .. Q
144 . Q
145 ;
146 D PRINT ; print the report
147 D ^%ZISC ; close the device
148 KILL ^TMP($J,RTN) ; kill scratch global
149 I $D(ZTQUEUED) S ZTREQ="@" ; purge the task record
150COMPX ;
151 Q
152 ;
153CALC(INS) ; extract insurance data for company ien=INS
154 ;
155 I '$$ACTIVE^IBCNEUT4(INS) G CALCX ; not active
156 S DATA=$G(^DIC(36,INS,0))
157 S ADDR=$G(^DIC(36,INS,.11))
158 S EDI=$G(^DIC(36,INS,3))
159 S PROFID=$P(EDI,U,2)
160 S INSTID=$P(EDI,U,4)
161 ;
162 I IBRBID,PROFID'="",INSTID'="",$$UP^XLFSTR(PROFID)'["PRNT",$$UP^XLFSTR(INSTID)'["PRNT" G CALCX
163 ;
164 S NAME=$P(DATA,U,1) S:NAME="" NAME="~UNK"
165 S STREET=$P(ADDR,U,1)
166 S CITY=$P(ADDR,U,4)
167 S STATE=+$P(ADDR,U,5)
168 S STATE=$S(STATE:$P($G(^DIC(5,STATE,0)),U,2),1:"")
169 S TYPCOV=$$EXTERNAL^DILFD(36,.13,,$P(DATA,U,13))
170 S TRANS=$$EXTERNAL^DILFD(36,3.01,,$P(EDI,U,1))
171 S INSTYP=$$EXTERNAL^DILFD(36,3.09,,$P(EDI,U,9))
172 ;
173 S SORT=" "
174 I IBRSORT=1,NAME'="" S SORT=" "_NAME
175 I IBRSORT=2,PROFID'="" S SORT=" "_PROFID
176 I IBRSORT=3,INSTID'="" S SORT=" "_INSTID
177 I IBRSORT=4,INSTYP'="" S SORT=" "_INSTYP
178 I IBRSORT=5,TYPCOV'="" S SORT=" "_TYPCOV
179 ;
180 S TMP=NAME_U_STREET_U_CITY_U_STATE_U_INSTYP_U_TYPCOV_U_TRANS_U_INSTID_U_PROFID
181 S ^TMP($J,RTN,SORT,NAME,INS)=TMP
182CALCX ;
183 Q
184 ;
185PRINT ; print the report to the specified device
186 NEW MAXCNT,CRT,PAGECNT,STOP,SORT,NAME,INS,DATA,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
187 I IOST["C-" S MAXCNT=IOSL-3,CRT=1
188 E S MAXCNT=IOSL-6,CRT=0
189 S PAGECNT=0,STOP=0
190 ;
191 I '$D(^TMP($J,RTN)) D HEADER W !!!?5,"No Data Found"
192 ;
193 S SORT=""
194 F S SORT=$O(^TMP($J,RTN,SORT)) Q:SORT="" D Q:STOP
195 . S NAME=""
196 . F S NAME=$O(^TMP($J,RTN,SORT,NAME)) Q:NAME="" D Q:STOP
197 .. S INS=0
198 .. F S INS=$O(^TMP($J,RTN,SORT,NAME,INS)) Q:'INS D Q:STOP
199 ... S DATA=$G(^TMP($J,RTN,SORT,NAME,INS))
200 ... I $Y+1>MAXCNT!'PAGECNT D HEADER Q:STOP
201 ... W !,$E($P(DATA,U,1),1,27) ; name
202 ... W ?29,$E($P(DATA,U,2),1,19) ; address1
203 ... W ?50,$E($P(DATA,U,3),1,13) ; city, st
204 ... I $P(DATA,U,3)'="",$P(DATA,U,4)'="" W ", "
205 ... W $E($P(DATA,U,4),1,2)
206 ... W ?69,$E($P(DATA,U,7),1,8) ; transmit elec
207 ... W ?79,$E($P(DATA,U,8),1,8) ; inst payer id
208 ... W ?89,$E($P(DATA,U,9),1,8) ; prof payer id
209 ... W ?99,$E($P(DATA,U,5),1,12) ; ins type
210 ... W ?113,$E($P(DATA,U,6),1,19) ; type of cov
211 ... Q
212 .. Q
213 . Q
214 ;
215 I STOP G PRINTX
216 W !!?5,"*** End of Report ***"
217 I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
218PRINTX ;
219 Q
220 ;
221HEADER ; page break and report header information
222 NEW LIN,HDR,TAB,C1,C2
223 S STOP=0
224 I CRT,PAGECNT>0,'$D(ZTQUEUED) D I STOP G HEADX
225 . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
226 . S DIR(0)="E" D ^DIR K DIR
227 . I 'Y S STOP=1 Q
228 . Q
229 ;
230 S PAGECNT=PAGECNT+1
231 W @IOF,!
232 ;
233 I IBRINS="A" W "All Companies"
234 I IBRINS="S" W "Selected Companies"
235 I IBRINS="R" D ; range description
236 . S C1=IBRINS1 I C1=" " S C1="First"
237 . S C2=IBRINS2 I C2="~~~~~" S C2="Last"
238 . W "Companies [",C1,"] through [",C2,"]"
239 . Q
240 ;
241 W ?45," Insurance Company EDI Parameter Report"
242 S HDR="Page: "_PAGECNT,TAB=132-$L(HDR)-1
243 W ?TAB,HDR
244 ;
245 W !,"Sorted By "
246 I IBRSORT=1 W "Ins Company Name"
247 I IBRSORT=2 W "Prof ID"
248 I IBRSORT=3 W "Inst ID"
249 I IBRSORT=4 W "Electronic Type"
250 I IBRSORT=5 W "Type of Coverage"
251 S HDR=$$FMTE^XLFDT($$NOW^XLFDT,"1Z"),TAB=132-$L(HDR)-1
252 W ?TAB,HDR
253 ;
254 W !,"Only Blank or 'PRNT' Bill ID's = ",$S(IBRBID:"YES",1:"NO")
255 ;
256 W !?69,"Electron",?79,"Inst",?89,"Prof",?99,"Electronic"
257 W !,"Insurance Company Name",?29,"Street Address",?50,"City"
258 W ?69,"Transmit",?80,"ID",?90,"ID",?102,"Type",?113,"Type of Coverage"
259 W !,$$RJ^XLFSTR("",132,"=")
260 ;
261 ; check for a stop request
262 I $D(ZTQUEUED),$$S^%ZTLOAD() D G HEADX
263 . S (ZTSTOP,STOP)=1
264 . W !!!?5,"*** Report Halted by TaskManager Request ***"
265 . Q
266HEADX ;
267 Q
268 ;
269DEVICE ; Device selection before compile
270 NEW ZTRTN,ZTDESC,ZTSAVE,POP
271 W !!!,"This report is 132 columns wide. Please choose an appropriate device.",!
272 S ZTRTN="COMPILE^IBCNSGE"
273 S ZTDESC="Insurance Company EDI Parameter Report"
274 S ZTSAVE("IBRINS")=""
275 S ZTSAVE("IBRBID")=""
276 S ZTSAVE("IBRINS1")=""
277 S ZTSAVE("IBRINS2")=""
278 S ZTSAVE("IBRSORT")=""
279 D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
280DEVX ;
281 Q
282 ;
Note: See TracBrowser for help on using the repository browser.