[628] | 1 | IBCNSC01 ;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 | ;
|
---|
| 5 | PARAM ; -- 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 | ;
|
---|
| 49 | PHONE(IBCNS13) ; -- Compute precert company phone
|
---|
| 50 | N IBX,IBSAVE,IBCNT S IBX=""
|
---|
| 51 | I '$P(IBCNS13,"^",9) S IBX=$P(IBCNS13,"^",3) G PHONEQ
|
---|
| 52 | REDOX 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
|
---|
| 61 | PHONEQ Q IBX
|
---|
| 62 | ;
|
---|
| 63 | MAIN ; -- 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 | ;
|
---|
| 81 | PAYER ; 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
|
---|
| 158 | PAYERX ;
|
---|
| 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 | ;
|
---|
| 167 | REMARKS ;
|
---|
| 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 | ;
|
---|
| 181 | SYN ;
|
---|
| 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 | ;
|
---|