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

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

initial load of WorldVistAEHR
File size: 8.7 KB
RevLine 
[613]1IBJPI ;DAOU/BHS - IBJP IIV SITE PARAMETERS SCREEN ;14-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,271,316**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; IIV - Insurance Identification and Verification Interface
6 ;
7EN ; main entry pt for IBJP IIV SITE PARAMS
8 N POP,X,CTRLCOL,VALMHDR,VALMCNT,%DT
9 D EN^VALM("IBJP IIV SITE PARAMETERS")
10 Q
11 ;
12HDR ; header
13 S VALMHDR(1)="Only authorized persons may edit this data."
14 Q
15 ;
16INIT ; init vars & list array
17 K ^TMP($J,"IBJPI")
18 ; Kills data and video control arrays with active list
19 D CLEAN^VALM10
20 D BLD
21 Q
22 ;
23HELP ; help
24 D FULL^VALM1
25 W @IOF
26 W !,"This screen displays all of the eIIV Site Parameters used to manage the"
27 W !,"eIIV application used for Insurance Identification and Verification."
28 W !!,"The first section, General Parameters, concerns overall parameters"
29 W !,"for monitoring the interface and controlling IIV communication"
30 W !,"between VistA and the EC located in Austin."
31 W !!,"The second section, Batch Extracts, concerns extract specific parameters"
32 W !,"including active status, selection criteria and maximum records extracted"
33 W !,"per day."
34 W !!,"The third section, Patients without Insurance, concerns whether or not"
35 W !,"identification inquiries should be made for patients without insurance on"
36 ;W !,"inactive policies or the Most Popular Payers list below to see if the"
37 W !,"inactive policies to see if the patient is covered by one of those companies"
38 ;W !,"patient is covered by one of those companies or payers."
39 W !,"or payers."
40 ;D PAUSE^VALM1
41 ;W !!,"The final section, Most Popular Payers, is a list maintained by users"
42 ;W !,"of the most popular payers for that site. This list is site-specific and"
43 ;W !,"is based on the payers selected by the user as those most likely to have"
44 ;W !,"coverage for a patient at the site. The columns display whether or not the"
45 ;W !,"payer is locally active or nationally active and the national payer id."
46 ;W !,"The locally active flag can be updated by the site as long as the eIIV"
47 ;W !,"application has not been deactivated. The nationally active flag"
48 ;W !,"is only updated by the Eligibility Communicator. Both flags must be set"
49 ;W !,"to YES for an insurance inquiry to be transmitted to the Eligibility"
50 ;W !,"Communicator."
51 D PAUSE^VALM1
52 W @IOF
53 S VALMBCK="R"
54 Q
55 ;
56EXIT ; exit
57 K ^TMP($J,"IBJPI")
58 D CLEAN^VALM10
59 Q
60 ;
61BLD ; build screen array
62 N IBLN,IBCOL,IBWID,IBIIV,IBIIVB,IBIEN,CT,IBEX1,IBEX2,IBEX,IEN
63 N IBST,IBDATA,DISYS,X,STATUS,AIEN,ADATA
64 ;
65 S (IBLN,VALMCNT)=0,IBCOL=3,IBIIV=$G(^IBE(350.9,1,51))
66 ; -- Gen Params
67 ; Skip line
68 S IBLN=$$SET("","",IBLN,0),IBWID=48
69 S IBLN=$$SETN("General Parameters",IBLN,IBCOL,1,)
70 S IBLN=$$SET("Days between electronic reverification checks: ",$P(IBIIV,U),IBLN,IBWID)
71 S IBLN=$$SET("Send daily statistical report via MailMan: ",$S($P(IBIIV,U,2):"YES",$P(IBIIV,U,2)=0:"NO",1:""),IBLN,IBWID)
72 I $P(IBIIV,U,2) S IBLN=$$SET("Time of day for daily statistical report: ",$P(IBIIV,U,3),IBLN,IBWID)
73 S IBLN=$$SET("Mail Group for eIIV messages: ",$$MGRP^IBCNEUT5,IBLN,IBWID)
74 S IBLN=$$SET("HL7 Response Processing Method: ",$S($P(IBIIV,U,13)="B":"BATCH",$P(IBIIV,U,13)="I":"IMMEDIATE",1:""),IBLN,IBWID)
75 I $P(IBIIV,U,13)="B" D
76 . S IBLN=$$SET("HL7 Batch Start Time: ",$P(IBIIV,U,14),IBLN,IBWID)
77 . S IBLN=$$SET("HL7 Batch Stop Time: ",$P(IBIIV,U,19),IBLN,IBWID)
78 S IBLN=$$SET("Daily Maximum HL7 Messages: ",$P(IBIIV,U,15),IBLN,IBWID)
79 S IBLN=$$SET("Contact Person: ",$S($P(IBIIV,U,16)'="":$$GET1^DIQ(200,$P(IBIIV,U,16)_",",.01,"E"),1:""),IBLN,IBWID)
80 S IBWID=62
81 S IBLN=$$SET("","",IBLN,0)
82 S IBLN=$$SET("Receive MailMan message when unable to electronically","",IBLN,IBWID-12)
83 S IBLN=$$SET("confirm insurance due to communication problem: ",$S($P(IBIIV,U,20):"YES",$P(IBIIV,U,20)=0:"NO",1:""),IBLN,IBWID-6)
84 ; Skip lines to force Batch Extracts to next page
85 S IBLN=$$SET("","",IBLN,0)
86 S IBLN=$$SET("","",IBLN,0)
87 S IBLN=$$SET("","",IBLN,0)
88 ; Skip lines for Immediate
89 I $P(IBIIV,U,13)'="B" D
90 . S IBLN=$$SET("","",IBLN,0)
91 . S IBLN=$$SET("","",IBLN,0)
92 ;
93 ; -- Batch Extracts
94 S IBWID=43
95 S IBLN=$$SETN("Batch Extracts",IBLN,IBCOL,1,)
96 S IBLN=$$SET("","",IBLN,0)
97 S IBLN=$$SET("Extract Selection Maximum # to","",IBLN,IBWID)
98 S IBLN=$$SETN(" Name On/Off Criteria Extract/Day",IBLN,IBCOL+1,,1)
99 ; Loop thru extracts
100 S IEN=0 F S IEN=$O(^IBE(350.9,1,51.17,IEN)) Q:'IEN D
101 . S IBIIVB=$G(^IBE(350.9,1,51.17,IEN,0))
102 . S IBEX=+$P(IBIIVB,U) ; Type
103 . S IBST=$$FO^IBCNEUT1($S($P(IBIIVB,U)'="":$$GET1^DIQ(350.9002,$P(IBIIVB,U)_",1,",.01,"E"),1:""),14)
104 . S IBST=IBST_$$FO^IBCNEUT1($S(+$P(IBIIVB,U,2):"ON",1:"OFF"),8)
105 . S IBEX1=$S(+$P(IBIIVB,U,3)'=0:+$P(IBIIVB,U,3),1:$P(IBIIVB,U,3))
106 . S IBEX2=$S(+$P(IBIIVB,U,4)'=0:+$P(IBIIVB,U,4),1:$P(IBIIVB,U,4))
107 . S IBST=IBST_$$FO^IBCNEUT1($S(IBEX=1:"N/A",IBEX=2:IBEX1,IBEX=3!(IBEX=4):IBEX1_"/"_IBEX2,1:"ERROR"),11)
108 . S IBST=IBST_$$FO^IBCNEUT1($S(+$P(IBIIVB,U,5):+$P(IBIIVB,U,5),1:$P(IBIIVB,U,5)),14)
109 . S IBLN=$$SET(IBST,"",IBLN,IBWID)
110 S IBLN=$$SET("","",IBLN,0)
111 ;
112 ; -- Pts w/o Ins
113 ; Skip line
114 S IBLN=$$SET("","",IBLN,0),IBWID=41
115 S IBLN=$$SETN("Patients Without Insurance",IBLN,IBCOL,1,)
116 S IBLN=$$SET("Look at a patient's inactive insurance? ",$S($P(IBIIV,U,8):"YES",$P(IBIIV,U,8)=0:"NO",1:""),IBLN,IBWID)
117 ;S IBLN=$$SET("Attempt inquiry by most popular payers? ",$S($P(IBIIV,U,9):"YES",$P(IBIIV,U,9)=0:"NO",1:""),IBLN,IBWID)
118 ;S IBLN=$$SET("How many payers to try? ",$P(IBIIV,U,10),IBLN,IBWID)
119 S IBLN=$$SET("","",IBLN,0)
120 S VALMCNT=IBLN
121 Q
122 ; No longer allowing the use of Most Popular Payers
123 ;
124 ; -- Most Popular Payers
125 ; Skip line
126 S IBLN=$$SET("","",IBLN,0),IBWID=12
127 S IBLN=$$SETN("Most Popular Payers",IBLN,IBCOL,1,)
128 ;
129 S IBLN=$$SET(" Saved By: ",$$GET1^DIQ(350.9,1,51.24),IBLN,IBWID)
130 S IBLN=$$SET("Last Saved: ",$$FMTE^XLFDT($P(IBIIV,U,21),"5Z"),IBLN,IBWID)
131 S IBWID=48
132 S IBST=" "_$$FO^IBCNEUT1(" ",36)_" "_$$FO^IBCNEUT1(" ",11)_" "_$$FO^IBCNEUT1("Nationally",10)_" "_$$FO^IBCNEUT1("Locally",7)
133 S IBLN=$$SET(IBST,"",IBLN,IBWID)
134 S IBST=" # "_$$FO^IBCNEUT1("Payer Name",36)_" "_$$FO^IBCNEUT1("National ID",11)_" "_$$FO^IBCNEUT1(" Active?",10)_" "_$$FO^IBCNEUT1(" Active?",8)
135 S IBLN=$$SETN(IBST,IBLN,IBCOL+1,,1)
136 ; Loop thru the current List of Payers
137 S (IEN,CT)=0 F S IEN=$O(^IBE(350.9,1,51.18,IEN)) Q:'IEN D
138 . S IBIEN=$P($G(^IBE(350.9,1,51.18,IEN,0)),U) Q:'IBIEN ; Bad IEN
139 . S CT=CT+1,IBST=$$FO^IBCNEUT1(CT,2,"R")_". "
140 . ; Payer Name
141 . S IBST=IBST_$$FO^IBCNEUT1($P($G(^IBE(365.12,IBIEN,0)),U),36)
142 . ; National ID
143 . S IBST=IBST_" "_$$FO^IBCNEUT1($P($G(^IBE(365.12,IBIEN,0)),U,2),11)
144 . ; Look up the payer application data
145 . S AIEN=$$PYRAPP^IBCNEUT5("IIV",IBIEN)
146 . ; WARNING - IIV application does not exist
147 . I AIEN="" D Q
148 . . S IBLN=$$SET(IBST,"",IBLN,IBWID)
149 . . S IBST=" ** Please remove from this list: Payer not configured for IIV **"
150 . . S IBLN=$$SET(IBST,"",IBLN,"")
151 . S ADATA=$G(^IBE(365.12,+IBIEN,1,+AIEN,0))
152 . S IBST=IBST_" "_$$FO^IBCNEUT1($S('$P(ADATA,U,2):" NO",1:" YES"),9)
153 . S IBST=IBST_" "_$$FO^IBCNEUT1($S('$P(ADATA,U,3):" NO",1:" YES"),7)
154 . S IBLN=$$SET(IBST,"",IBLN,"")
155 . ; WARNING - IIV application deactivated
156 . I +$P(ADATA,U,11) D Q
157 . . S IBST=" ** Please remove from this list: Payer is deactivated for IIV **"
158 . . S IBLN=$$SET(IBST,"",IBLN,"")
159 . ; WARNING - Id Inq Req ID = YES & Use SSN as ID = NO
160 . I +$P(ADATA,U,8),'$P(ADATA,U,9) D Q
161 . . S IBST=" ** Please remove from this list: Inquiries w/o subscriber ID rejected **"
162 . . S IBLN=$$SET(IBST,"",IBLN,"")
163 ; No Data Found if CT=0
164 I CT=0 S IBLN=$$SET($$FO^IBCNEUT1("*** NO DATA FOUND!!!! ***",60),"",IBLN,IBWID)
165 S IBLN=$$SET("","",IBLN,0),IBWID=71
166 S IBLN=$$SET("A payer will be available for electronic identification only if it is","",IBLN,IBWID)
167 S IBLN=$$SET($$FO^IBCNEUT1(" both nationally and locally active.",IBWID),"",IBLN,IBWID)
168 ;
169 S VALMCNT=IBLN
170 ;
171 Q
172 ;
173SET(TTL,DATA,LN,WID) ;
174 ; TTL = caption for field
175 ; DATA = field value
176 ; LN = current line #
177 ; WID = right justify width
178 N IBY
179 ; update line ct
180 S LN=LN+1
181 ; offset line by 3 spaces
182 S IBY=" "_$J(TTL,WID)_DATA D SET1(IBY,LN,0,$L(IBY))
183 Q LN
184 ;
185SETN(TTL,LN,COL,RV,UN) ;
186 ; TTL = caption for field
187 ; LN = current line #
188 ; COL = column at which to start video attribute
189 ; RV = 0/1 flag for reverse video
190 ; UN = 0/1 flag for underline
191 N IBY
192 ; update line ct
193 S LN=LN+1
194 ; offset line by 2 spaces
195 S IBY=" "_TTL D SET1(IBY,LN,COL,$L(TTL),$G(RV),$G(UN))
196 Q LN
197 ;
198SET1(STR,LN,COL,WD,RV,UN) ; Set up ^TMP array with screen data
199 ; STR = line text
200 ; LN = current line #
201 ; COL = column at which to start video attribute
202 ; WD = width of video attribute
203 ; RV = 0/1 flag for reverse video
204 ; UN = 0/1 flag for underline
205 D SET^VALM10(LN,STR)
206 I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
207 I $G(UN)'="" D CNTRL^VALM10(LN,COL,WD-1,IOUON,IOUOFF)
208 Q
209 ;
Note: See TracBrowser for help on using the repository browser.