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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1IBCNSC01 ;ALB/NLR - INSURANCE COMPANY EDIT ;6/1/05 10:06am
2 ;;2.0;INTEGRATED BILLING;**52,137,191,184,232,320,349,371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5PARAM ; -- Insurance company parameters region
6 N OFFSET,START,IBCNS0,IBCNS03,IBCNS06,IBCNS08,IBCNS13,IBCNS3
7 S IBCNS0=$G(^DIC(36,+IBCNS,0)),IBCNS3=$G(^(3))
8 S IBCNS03=$P(IBCNS0,"^",3),IBCNS06=$P(IBCNS0,"^",6),IBCNS08=$P(IBCNS0,"^",8)
9 S IBCNS13=$G(^DIC(36,+IBCNS,.13))
10 S START=1,OFFSET=2
11 D SET^IBCNSP(START,OFFSET+25," Billing Parameters ",IORVON,IORVOFF)
12 ;
13 D SET^IBCNSP(START+1,OFFSET+1,"Signature Required?: "_$S(+IBCNS03:"YES",1:"NO"))
14 D SET^IBCNSP(START+2,OFFSET+10,"Reimburse?: "_$E($$EXPAND^IBTRE(36,1,$P(IBCNS0,"^",2)),1,21))
15 D SET^IBCNSP(START+3,OFFSET+3,"Mult. Bedsections: "_$S(+IBCNS06:"YES",IBCNS06=0:"NO",1:""))
16 D SET^IBCNSP(START+4,OFFSET+4,"Diff. Rev. Codes: "_$P(IBCNS0,"^",7))
17 D SET^IBCNSP(START+5,OFFSET+6,"One Opt. Visit: "_$S(+IBCNS08:"YES",1:"NO"))
18 D SET^IBCNSP(START+6,OFFSET+1,"Amb. Sur. Rev. Code: "_$P(IBCNS0,"^",9))
19 D SET^IBCNSP(START+7,OFFSET+1,"Rx Refill Rev. Code: "_$P(IBCNS0,"^",15))
20 ;
21 S OFFSET=45
22 D SET^IBCNSP(START+1,OFFSET+3,"Filing Time Frame: "_$P(IBCNS0,"^",12))
23 D SET^IBCNSP(START+2,OFFSET+4,"Type Of Coverage: "_$$EXPAND^IBTRE(36,.13,+$P(IBCNS0,U,13)))
24 D SET^IBCNSP(START+3,OFFSET+7,"Billing Phone: "_$P(IBCNS13,"^",2))
25 D SET^IBCNSP(START+4,OFFSET+2,"Verification Phone: "_$P(IBCNS13,"^",4))
26 D SET^IBCNSP(START+5,OFFSET+2,"Precert Comp. Name: "_$P($G(^DIC(36,+$P(IBCNS13,"^",9),0)),"^",1))
27 D SET^IBCNSP(START+6,OFFSET+7,"Precert Phone: "_$$PHONE(IBCNS13))
28 I +IBCNS3=2 D SET^IBCNSP(START+7,OFFSET,"Max # Test Bills/Day: "_$P(IBCNS3,U,6))
29 ;
30 S START=11,OFFSET=2
31 D SET^IBCNSP(START,OFFSET+28," EDI Parameters ",IORVON,IORVOFF)
32 D SET^IBCNSP(START+1,OFFSET+13,"Transmit?: "_$S(+IBCNS3=1:"YES-LIVE",+IBCNS3=2:"TEST ONLY",1:"NO"))
33 D SET^IBCNSP(START+2,OFFSET+1,"Inst Payer Primary ID: "_$P(IBCNS3,U,4))
34 D SET^IBCNSP(START+3,OFFSET,"Inst Payer Sec ID Qual: "_$$GET1^DIQ(36,+IBCNS,6.01))
35 D SET^IBCNSP(START+4,OFFSET+5,"Inst Payer Sec ID: "_$$GET1^DIQ(36,+IBCNS,6.02))
36 D SET^IBCNSP(START+5,OFFSET,"Inst Payer Sec ID Qual: "_$$GET1^DIQ(36,+IBCNS,6.03))
37 D SET^IBCNSP(START+6,OFFSET+5,"Inst Payer Sec ID: "_$$GET1^DIQ(36,+IBCNS,6.04))
38 D SET^IBCNSP(START+7,OFFSET+12,"Bin Number: "_$P($G(^DIC(36,+IBCNS,3)),"^",3)) ;
39 ;
40 S OFFSET=41
41 D SET^IBCNSP(START+1,OFFSET+8," Insurance Type: "_$$EXPAND^IBTRE(36,3.09,+$P(IBCNS3,U,9)))
42 D SET^IBCNSP(START+2,OFFSET+1," Prof Payer Primary ID: "_$P(IBCNS3,U,2))
43 D SET^IBCNSP(START+3,OFFSET," Prof Payer Sec ID Qual: "_$$GET1^DIQ(36,+IBCNS,6.05))
44 D SET^IBCNSP(START+4,OFFSET+5," Prof Payer Sec ID: "_$$GET1^DIQ(36,+IBCNS,6.06))
45 D SET^IBCNSP(START+5,OFFSET," Prof Payer Sec ID Qual: "_$$GET1^DIQ(36,+IBCNS,6.07))
46 D SET^IBCNSP(START+6,OFFSET+5," Prof Payer Sec ID: "_$$GET1^DIQ(36,+IBCNS,6.08))
47 Q
48 ;
49PHONE(IBCNS13) ; -- Compute precert company phone
50 N IBX,IBSAVE,IBCNT S IBX=""
51 I '$P(IBCNS13,"^",9) S IBX=$P(IBCNS13,"^",3) G PHONEQ
52REDOX S IBSAVE=+$P(IBCNS13,"^",9)
53 S IBCNT=$G(IBCNT)+1
54 ; -- if you process the same co. more than once you are in an infinite loop
55 I $D(IBCNT(IBCNS)) G PHONEQ
56 S IBCNT(IBCNS)=""
57 S IBCNS13=$G(^DIC(36,+$P(IBCNS13,"^",9),.13))
58 S IBX=$P(IBCNS13,"^") S:$L($P(IBCNS13,"^",3)) IBX=$P(IBCNS13,"^",3)
59 ; -- if process the same co. more than once you are in an infinite loop
60 I $P(IBCNS13,"^",9),$P(IBCNS13,"^",9)'=IBSAVE G REDOX
61PHONEQ Q IBX
62 ;
63MAIN ; -- Insurance company main address
64 N OFFSET,START,IBCNS11,IBCNS13,IBADD
65 S IBCNS11=$G(^DIC(36,+IBCNS,.11))
66 S IBCNS13=$G(^DIC(36,+IBCNS,.13))
67 S START=21,OFFSET=25
68 D SET^IBCNSP(START,OFFSET," Main Mailing Address ",IORVON,IORVOFF)
69 N OFFSET S OFFSET=2
70 D SET^IBCNSP(START+1,OFFSET," Street: "_$P(IBCNS11,"^",1)) S IBADD=1
71 D SET^IBCNSP(START+2,OFFSET," Street 2: "_$P(IBCNS11,"^",2)) S IBADD=2
72 D SET^IBCNSP(START+3,OFFSET," Street 3: "_$P(IBCNS11,"^",3)) S IBADD=3
73 ; D SET^IBCNSP(START+4,OFFSET,"Claim Off. ID: "_$P(IBCNS11,U,11))
74 N OFFSET S OFFSET=45
75 D SET^IBCNSP(START+1,OFFSET," City/State: "_$E($P(IBCNS11,"^",4),1,15)_$S($P(IBCNS11,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS11,"^",5),0)),"^",2)_" "_$E($P(IBCNS11,"^",6),1,5))
76 D SET^IBCNSP(START+2,OFFSET," Phone: "_$P(IBCNS13,"^",1))
77 D SET^IBCNSP(START+3,OFFSET," Fax: "_$P(IBCNS11,"^",9))
78 Q
79 ;
80 ;
81PAYER ; This procedure builds the display for the payer associated with
82 ; this insurance company.
83 ; ESG - 7/29/02 - IIV project
84 ;
85 NEW PAYERIEN,PAYR,APPDATA,APP,DATA,APPNAME,A1,A2,A3,A4,A5,A6,A7,A8
86 NEW START,TITLE,OFFSET,IBLINE
87 S PAYERIEN=$P($G(^DIC(36,+IBCNS,3)),U,10),PAYR="",APPDATA=0
88 I PAYERIEN D
89 . S PAYR=$G(^IBE(365.12,PAYERIEN,0))
90 . S APP=0
91 . F S APP=$O(^IBE(365.12,PAYERIEN,1,APP)) Q:'APP D
92 .. S DATA=$G(^IBE(365.12,PAYERIEN,1,APP,0))
93 .. S APPNAME=$$EXTERNAL^DILFD(365.121,.01,"",$P(DATA,U,1))
94 .. I APPNAME="" Q
95 .. I $D(APPDATA(APPNAME)) Q
96 .. S (A1,A2,A3,A4,A5,A6,A7)="NO",A8=""
97 .. I $P(DATA,U,2) S A1="YES" ; national active
98 .. I $P(DATA,U,3) S A2="YES" ; local active
99 .. I $P(DATA,U,7) S A3="YES" ; auto-accept
100 .. I $P(DATA,U,8) S A4="YES" ; ident inquiries require subscr ID
101 .. I $P(DATA,U,9) S A5="YES" ; use SSN for subscriber ID
102 .. I $P(DATA,U,10) S A6="YES" ; transmit SSN
103 .. I $P(DATA,U,11) S A7="YES" ; deactivated?
104 .. ; A8 = deactivation date
105 .. I $P(DATA,U,12) S A8=$P($$FMTE^XLFDT($P(DATA,U,12),"5Z"),"@",1)
106 .. S APPDATA(APPNAME)=A1_U_A2_U_A3_U_A4_U_A5_U_A6_U_A7_U_A8
107 .. S APPDATA=APPDATA+1
108 .. Q
109 . Q
110 ;
111 S START=$O(^TMP("IBCNSC",$J,""),-1)+1
112 S IB1ST("PAYER")=START
113 S TITLE=" Payer Information/Electronic Insurance Verification "
114 S OFFSET=(40-($L(TITLE)/2))\1+1
115 D SET^IBCNSP(START,OFFSET,TITLE,IORVON,IORVOFF)
116 D SET^IBCNSP(START+1,9,"Payer Name: "_$P(PAYR,U,1))
117 D SET^IBCNSP(START+2,5,"VA National ID: "_$P(PAYR,U,2))
118 D SET^IBCNSP(START+2,51,"CMS National ID: "_$P(PAYR,U,3))
119 S IBLINE=START+2
120 ;
121 ; Handle the case where no application data is defined
122 I 'APPDATA D G PAYERX
123 . S IBLINE=IBLINE+1
124 . D SET^IBCNSP(IBLINE,2," ") ; blank line
125 . S IBLINE=IBLINE+1
126 . D SET^IBCNSP(IBLINE,16,"Payer Application data is not defined!")
127 . Q
128 ;
129 ; Display all the applications
130 S APPNAME=""
131 F S APPNAME=$O(APPDATA(APPNAME)) Q:APPNAME="" D
132 . S IBLINE=IBLINE+1
133 . D SET^IBCNSP(IBLINE,2," ") ; blank line
134 . ;
135 . S IBLINE=IBLINE+1
136 . D SET^IBCNSP(IBLINE,2,"Payer Application: "_APPNAME)
137 . D SET^IBCNSP(IBLINE,50,"Auto-Accept Info: "_$P(APPDATA(APPNAME),U,3))
138 . ;
139 . S IBLINE=IBLINE+1
140 . D SET^IBCNSP(IBLINE,4,"National Active: "_$P(APPDATA(APPNAME),U,1))
141 . D SET^IBCNSP(IBLINE,47,"Ident Req Subscr ID: "_$P(APPDATA(APPNAME),U,4))
142 . ;
143 . S IBLINE=IBLINE+1
144 . D SET^IBCNSP(IBLINE,7,"Local Active: "_$P(APPDATA(APPNAME),U,2))
145 . D SET^IBCNSP(IBLINE,51,"SSN = Subscr ID: "_$P(APPDATA(APPNAME),U,5))
146 . ;
147 . S IBLINE=IBLINE+1
148 . D SET^IBCNSP(IBLINE,8,"Deactivated: "_$P(APPDATA(APPNAME),U,7))
149 . D SET^IBCNSP(IBLINE,54,"Transmit SSN: "_$P(APPDATA(APPNAME),U,6))
150 . ;
151 . ; If no deactivated date, then exit
152 . I $P(APPDATA(APPNAME),U,8)="" Q
153 . ;
154 . S IBLINE=IBLINE+1
155 . D SET^IBCNSP(IBLINE,13,"D-Date: "_$P(APPDATA(APPNAME),U,8))
156 . ;
157 . Q
158PAYERX ;
159 ; Two trailing blank lines after payer information display
160 S IBLINE=IBLINE+1
161 D SET^IBCNSP(IBLINE,2," ") ; blank line
162 S IBLINE=IBLINE+1
163 D SET^IBCNSP(IBLINE,2," ") ; blank line
164 Q
165 ;
166 ;
167REMARKS ;
168 ;
169 N OFFSET,START,IBLCNT,IBI
170 S START=$O(^TMP("IBCNSC",$J,""),-1)+1,OFFSET=2
171 S IB1ST("REM")=START
172 ;
173 D SET^IBCNSP(START,OFFSET," Remarks ",IORVON,IORVOFF)
174 S (IBLCNT,IBI)=0 F S IBI=$O(^DIC(36,+IBCNS,11,IBI)) Q:IBI<1 D
175 . S IBLCNT=IBLCNT+1
176 . D SET^IBCNSP(START+IBLCNT,OFFSET," "_$E($G(^DIC(36,+IBCNS,11,IBI,0)),1,80))
177 . Q
178 D SET^IBCNSP(START+IBLCNT+1,OFFSET," ") ; blank line after remarks
179 Q
180 ;
181SYN ;
182 N OFFSET,START,SYN,SYNOI
183 S START=$O(^TMP("IBCNSC",$J,""),-1)+1,OFFSET=2
184 S IB1ST("SYN")=START
185 D SET^IBCNSP(START,OFFSET," Synonyms ",IORVON,IORVOFF)
186 S SYN="" F SYNOI=1:1:8 S SYN=$O(^DIC(36,+IBCNS,10,"B",SYN)) Q:SYN="" D SET^IBCNSP(START+SYNOI,OFFSET,$S(SYNOI>7:" ...edit to see more...",1:" "_SYN))
187 Q
188 ;
Note: See TracBrowser for help on using the repository browser.