IBVCB1 ;LITS/MRD - VIEW CANCELLED BILL, CONT. ;25-JUN-14
;;2.0;INTEGRATED BILLING;**516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
PART2 ; Chiropractic Data, Ambulance Data, etc.
;
N IBADD1,IBADD2,IBCITY,IBCOM1,IBCOM2,IBDOADD,IBFIND,IBPROV,IBPROVID,IBPUADD,IBREVCD,IBROLE,IBROLEX,IBSTATE,IBX,IBX1,IBX2,IBX3,IBX4,IBX5,IBX6,IBZIP
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Chiropractic Data"
S IBTEXT(3,1)="-----------------"
D LINE^IBVCB(.IBTEXT)
;
S IBX1=$$GET1^DIQ(399,IBIFN_",",246,"E")
S IBX2=$$GET1^DIQ(399,IBIFN_",",245,"E")
S IBX3=$$GET1^DIQ(399,IBIFN_",",247,"E")
S IBX4=$$GET1^DIQ(399,IBIFN_",",248,"E")
I (IBX1_IBX2_IBX3_IBX4)'="" D
. S IBTEXT(1,1)="Initial TX Date: "_IBX1
. S IBTEXT(1,2)="Last XRAY Date: "_IBX2
. S IBTEXT(2,1)="Acute Manifestation Date: "_IBX3
. S IBTEXT(2,2)="Condition Code: "_IBX4
. D LINE^IBVCB(.IBTEXT)
. Q
E D
. S IBTEXT(1,1)="*** No Chiropractic Data Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Ambulance Data"
S IBTEXT(3,1)="--------------"
D LINE^IBVCB(.IBTEXT)
;
S IBADD1=$$GET1^DIQ(399,IBIFN_",",271,"E")
S IBADD2=$$GET1^DIQ(399,IBIFN_",",272,"E")
S IBCITY=$$GET1^DIQ(399,IBIFN_",",273,"E")
S IBSTATE=$$GET1^DIQ(399,IBIFN_",",274,"E")
S IBZIP=$$GET1^DIQ(399,IBIFN_",",275,"E")
S IBPUADD=IBADD1_" "_IBADD2_" "_IBCITY_" "_IBSTATE_" "_IBZIP
;
S IBTEXT(1,1)="D/O Location: "_$$GET1^DIQ(399,IBIFN_",",276,"E")
S IBADD1=$$GET1^DIQ(399,IBIFN_",",277,"E")
S IBADD2=$$GET1^DIQ(399,IBIFN_",",278,"E")
S IBCITY=$$GET1^DIQ(399,IBIFN_",",279,"E")
S IBSTATE=$$GET1^DIQ(399,IBIFN_",",280,"E")
S IBZIP=$$GET1^DIQ(399,IBIFN_",",281,"E")
S IBDOADD=IBADD1_" "_IBADD2_" "_IBCITY_" "_IBSTATE_" "_IBZIP
;
S IBX1=$$GET1^DIQ(399,IBIFN_",",287,"E")
S IBX2=$$GET1^DIQ(399,IBIFN_",",289,"E")
S IBX3=$$GET1^DIQ(399,IBIFN_",",288,"E")
S IBX4=$$GET1^DIQ(399,IBIFN_",",290,"E")
S IBX5=$$GET1^DIQ(399,IBIFN_",",291,"E")
;
I (IBPUADD_IBDOADD_IBX1_IBX2_IBX3_IBX4_IBX5)'="" D
. S IBTEXT(1,1)="P/U Address: "_IBPUADD
. S IBTEXT(2,1)="D/O Address: "_IBDOADD
. S IBTEXT(3,1)="Pt. Weight: "_IBX1
. S IBTEXT(3,2)="Transport Distance: "_IBX2
. S IBTEXT(4,1)="Transport Reason: "_IBX3
. S IBTEXT(5,1)="R/T Purpose: "_IBX4
. S IBTEXT(6,1)="Stretcher Purpose: "_IBX5
. D LINE^IBVCB(.IBTEXT)
. Q
E D
. S IBTEXT(1,1)="*** No Ambulance Data Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Ambulance Conditions"
S IBTEXT(3,1)="--------------------"
D LINE^IBVCB(.IBTEXT)
;
S IBFIND=0,IBX=0
F S IBX=$O(^DGCR(399,IBIFN,"U9",IBX)) Q:'IBX D
. S IBFIND=1
. S IBTEXT(1,1)="Ambulance Condition: "_$$GET1^DIQ(399.0292,IBX_","_IBIFN_",",.01,"E")
. D LINE^IBVCB(.IBTEXT)
. Q
I 'IBFIND D
. S IBTEXT(2,1)="*** No Ambulance Conditions Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Property & Casualty Data"
S IBTEXT(3,1)="------------------------"
D LINE^IBVCB(.IBTEXT)
;
S IBX1=$$GET1^DIQ(399,IBIFN_",",261,"E")
S IBX2=$$GET1^DIQ(399,IBIFN_",",262,"E")
S IBX3=$$GET1^DIQ(399,IBIFN_",",268,"E")
S IBX4=$$GET1^DIQ(399,IBIFN_",",269,"E")
S IBX5=$$GET1^DIQ(399,IBIFN_",",269.1,"E")
;
I (IBX1_IBX2_IBX3_IBX4)'="" D
. S IBTEXT(1,1)="Claim Number: "_IBX1
. S IBTEXT(1,2)="Date First Contact: "_IBX2
. S IBTEXT(2,1)="Contact Name: "_IBX3
. S IBTEXT(2,2)="Communication No.: "_IBX4_$S(IBX5'="":" Ext."_IBX5,1:"")
. D LINE^IBVCB(.IBTEXT)
. Q
E D
. S IBTEXT(1,1)="*** No Property & Casualty Data Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Claim Level Providers"
S IBTEXT(3,1)="---------------------"
D LINE^IBVCB(.IBTEXT)
;
S IBFIND=0
F IBROLE=4,3,2,9,1,5 D
. S IBROLEX=$S(IBROLE=1:"Referring",IBROLE=2:"Operating",IBROLE=3:"Rendering",IBROLE=4:"Attending",IBROLE=5:"Supervising",IBROLE=9:"Other Oper.",1:"")
. S IBPROV=0
. F S IBPROV=$O(^DGCR(399,IBIFN,"PRV",IBPROV)) Q:'IBPROV D
. . I IBROLE'=$P(^DGCR(399,IBIFN,"PRV",IBPROV,0),U) Q
. . S IBFIND=1
. . ;
. . S IBTEXT(1,1)=IBROLEX_": "_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.02,"E")
. . S IBTEXT(1,2)="Credentials: "_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.03,"E")
. . S IBTEXT(2,1)="Specialty: "_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.08,"E")
. . S IBTEXT(2,2)="Taxonomy: "_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.15,"E")
. . ;
. . S IBPROVID=$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.12,"E")_"/"_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.05,"E")
. . S IBTEXT(3,1)="Prim Payer Qual/ID: "_IBPROVID
. . S IBPROVID=$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.13,"E")_"/"_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.06,"E")
. . S IBTEXT(3,2)="Sec Payer Qual/ID: "_IBPROVID
. . S IBPROVID=$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.14,"E")_"/"_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.07,"E")
. . S IBTEXT(4,1)="Tert Payer Qual/ID: "_IBPROVID
. . D LINE^IBVCB(.IBTEXT)
. . ;
. . Q
. Q
I 'IBFIND D
. S IBTEXT(5,1)="*** No Claim Level Providers Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Non-VA Facility Data - Fee"
S IBTEXT(3,1)="--------------------------"
D LINE^IBVCB(.IBTEXT)
;
S IBX1=$$GET1^DIQ(399,IBIFN_",",232,"E")
S IBX2=$$GET1^DIQ(399,IBIFN_",",233,"E")
S IBX3=$$GET1^DIQ(399,IBIFN_",",234,"E")
S IBX4=$$GET1^DIQ(399,IBIFN_",",244,"E")
I (IBX1_IBX2_IBX3_IBX4)'="" D
. S IBTEXT(1,1)="Facility: "_IBX1
. S IBTEXT(1,2)="Care Type: "_IBX2
. S IBTEXT(2,1)="Non-VA ID: "_IBX3
. S IBTEXT(2,2)="Taxonomy: "_IBX4
. D LINE^IBVCB(.IBTEXT)
. Q
E D
. S IBTEXT(1,1)="*** No Non-VA Facility Data Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Comments/Signature Block"
S IBTEXT(3,1)="------------------------"
D LINE^IBVCB(.IBTEXT)
;
S IBX1=$$GET1^DIQ(399,IBIFN_",",400,"E")
S IBX2=$$GET1^DIQ(399,IBIFN_",",459,"E")
S IBX3=$$GET1^DIQ(399,IBIFN_",",402,"E")
I (IBX1_IBX2_IBX3)'="" D
. S IBTEXT(1,1)="Box 31 (CMS1500): "_IBX1
. S IBTEXT(2,1)="Box 19 (CMS1500): "_IBX2
. S IBTEXT(3,1)="FL 80 (UB04): "_IBX3
. D LINE^IBVCB(.IBTEXT)
. Q
E D
. S IBTEXT(1,1)="*** No Comments/Signature Block Data Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="ECME Data"
S IBTEXT(3,1)="---------"
D LINE^IBVCB(.IBTEXT)
;
S IBX1=$$GET1^DIQ(399,IBIFN_",",460,"E")
S IBX2=$$GET1^DIQ(399,IBIFN_",",461,"E")
I (IBX1_IBX2)'="" D
. S IBTEXT(1,1)="ECME Number: "_IBX1
. S IBTEXT(1,2)="ECME Approval: "_IBX2
. D LINE^IBVCB(.IBTEXT)
. Q
E D
. S IBTEXT(1,1)="*** No ECME Data Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="EOB/MRA Data"
S IBTEXT(3,1)="------------"
D LINE^IBVCB(.IBTEXT)
;
S IBX1=$$GET1^DIQ(399,IBIFN_",",22,"E")
S IBX2=$$GET1^DIQ(399,IBIFN_",",24,"E")
S IBX3=$$GET1^DIQ(399,IBIFN_",",453,"E")
S IBX4=$$GET1^DIQ(399,IBIFN_",",454,"E")
S IBX5=$$GET1^DIQ(399,IBIFN_",",455,"E")
I (IBX1_IBX2_IBX3_IBX4_IBX5)'="" D
. S IBTEXT(1,1)="Date MRA Received: "_IBX1
. S IBTEXT(1,2)="MRA Status: "_IBX2
. S IBTEXT(2,1)="Primary ICN: "_IBX3
. S IBTEXT(2,2)="Secondary ICN: "_IBX4
. S IBTEXT(3,1)="Tertiary ICN: "_IBX5
. D LINE^IBVCB(.IBTEXT)
. Q
E D
. S IBTEXT(1,1)="*** No EOB/MRA Data Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="PRV Diagnosis Codes"
S IBTEXT(3,1)="-------------------"
D LINE^IBVCB(.IBTEXT)
;
S IBX1=$$GET1^DIQ(399,IBIFN_",",249,"E")
S IBX2=$$GET1^DIQ(399,IBIFN_",",250,"E")
S IBX3=$$GET1^DIQ(399,IBIFN_",",251,"E")
I (IBX1_IBX2_IBX3)'="" D
. S IBTEXT(1,1)="PRV #1: "_IBX1
. S IBTEXT(1,2)="PRV #2: "_IBX2
. S IBTEXT(2,1)="PRV #3: "_IBX3
. D LINE^IBVCB(.IBTEXT)
. Q
E D
. S IBTEXT(1,1)="*** No PRV Diagnosis Code Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Comments"
S IBTEXT(3,1)="--------"
D LINE^IBVCB(.IBTEXT)
;
S IBFIND=0,IBCOM1=0
F S IBCOM1=$O(^DGCR(399,IBIFN,"TXC",IBCOM1)) Q:'IBCOM1 D
. S IBCOM2=0
. F S IBCOM2=$O(^DGCR(399,IBIFN,"TXC",IBCOM1,1,IBCOM2)) Q:'IBCOM2 D
. . S IBFIND=1
. . S IBTEXT(1,1)="MRA WL Comments: "_$$GET1^DIQ(399.0771,IBCOM2_","_IBCOM1_","_IBIFN_",",.01,"E")
. . S IBTEXT(2,1)="MRA WL Comments Date: "_$$GET1^DIQ(399.077,IBCOM1_","_IBIFN_",",.01,"E")
. . S IBTEXT(2,2)="Entered By: "_$$GET1^DIQ(399.077,IBCOM1_","_IBIFN_",",.02,"E")
. . D LINE^IBVCB(.IBTEXT)
. . Q
. Q
I 'IBFIND D
. S IBTEXT(1,1)="*** No MRA WL Comments Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBFIND=0,IBCOM1=0
F S IBCOM1=$O(^DGCR(399,IBIFN,"TXC2",IBCOM1)) Q:'IBCOM1 D
. S IBCOM2=0
. F S IBCOM2=$O(^DGCR(399,IBIFN,"TXC2",IBCOM1,1,IBCOM2)) Q:'IBCOM2 D
. . S IBFIND=1
. . S IBTEXT(1,1)="COB WL Comments: "_$$GET1^DIQ(399.0781,IBCOM2_","_IBCOM1_","_IBIFN_",",.01,"E")
. . S IBTEXT(2,1)="COB WL Comments Date: "_$$GET1^DIQ(399.078,IBCOM1_","_IBIFN_",",.01,"E")
. . S IBTEXT(2,2)="Entered By: "_$$GET1^DIQ(399.078,IBCOM1_","_IBIFN_",",.02,"E")
. . D LINE^IBVCB(.IBTEXT)
. . Q
. Q
I 'IBFIND D
. S IBTEXT(1,1)="*** No COB WL Comments Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Referral/Authorization Code"
S IBTEXT(3,1)="---------------------------"
D LINE^IBVCB(.IBTEXT)
;
S IBX1=$$GET1^DIQ(399,IBIFN_",",163,"E")
S IBX2=$$GET1^DIQ(399,IBIFN_",",230,"E")
S IBX3=$$GET1^DIQ(399,IBIFN_",",231,"E")
S IBX4=$$GET1^DIQ(399,IBIFN_",",253,"E")
S IBX5=$$GET1^DIQ(399,IBIFN_",",254,"E")
S IBX6=$$GET1^DIQ(399,IBIFN_",",255,"E")
I (IBX1_IBX2_IBX3_IBX4_IBX5_IBX6)'="" D
. S IBTEXT(1,1)="A/Primary: "_IBX1
. S IBTEXT(1,2)="A/Secondary: "_IBX2
. S IBTEXT(2,1)="A/Tertiary: "_IBX3
. S IBTEXT(2,2)="R/Primary: "_IBX4
. S IBTEXT(3,1)="R/Secondary: "_IBX5
. S IBTEXT(3,2)="R/Tertiary: "_IBX6
. D LINE^IBVCB(.IBTEXT)
. Q
E D
. S IBTEXT(1,1)="*** No Referral/Authorization Code Data Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Revenue Codes"
S IBTEXT(3,1)="-------------"
D LINE^IBVCB(.IBTEXT)
;
S IBFIND=0,IBREVCD=0
F S IBREVCD=$O(^DGCR(399,IBIFN,"RC",IBREVCD)) Q:'IBREVCD D
. ; Print a blank line if this is not the first revenue code.
. I IBFIND S IBTEXT(1,1)="" D LINE^IBVCB(.IBTEXT)
. S IBFIND=1
. S IBTEXT(1,1)="Code: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.01,"E")
. S IBTEXT(1,2)="Number: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.001,"E")
. ;
. S IBTEXT(2,1)="Charges: "_$$DOLLAR^IBVCB($$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.02,"E"))
. S IBTEXT(2,2)="Units: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.03,"E")
. ;
. S IBTEXT(3,1)="Total Charges: "_$$DOLLAR^IBVCB($$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.04,"E"))
. S IBTEXT(3,2)="Bedsection: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.05,"E")
. ;
. S IBTEXT(4,1)="Procedure: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.06,"E")
. S IBTEXT(4,2)="RX Procedure: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.15,"E")
. ;
. S IBTEXT(5,1)="Division: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.07,"E")
. S IBTEXT(5,2)="Type: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.1,"E")
. ;
. S IBTEXT(6,1)="Non-covered Charges: "_$$DOLLAR^IBVCB($$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.09,"E"))
. S IBTEXT(6,2)="Component: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.12,"E")
. D LINE^IBVCB(.IBTEXT)
. ;
. Q
I 'IBFIND D
. S IBTEXT(1,1)="*** No Revenue Codes Found ***"
. D LINE^IBVCB(.IBTEXT)
. Q
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBVCB1 11603 printed Apr 09, 2024@21:29:57 Page 2
IBVCB1 ;LITS/MRD - VIEW CANCELLED BILL, CONT. ;25-JUN-14
+1 ;;2.0;INTEGRATED BILLING;**516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
PART2 ; Chiropractic Data, Ambulance Data, etc.
+1 ;
+2 NEW IBADD1,IBADD2,IBCITY,IBCOM1,IBCOM2,IBDOADD,IBFIND,IBPROV,IBPROVID,IBPUADD,IBREVCD,IBROLE,IBROLEX,IBSTATE,IBX,IBX1,IBX2,IBX3,IBX4,IBX5,IBX6,IBZIP
+3 ;
+4 SET IBTEXT(1,1)=""
+5 SET IBTEXT(2,1)="Chiropractic Data"
+6 SET IBTEXT(3,1)="-----------------"
+7 DO LINE^IBVCB(.IBTEXT)
+8 ;
+9 SET IBX1=$$GET1^DIQ(399,IBIFN_",",246,"E")
+10 SET IBX2=$$GET1^DIQ(399,IBIFN_",",245,"E")
+11 SET IBX3=$$GET1^DIQ(399,IBIFN_",",247,"E")
+12 SET IBX4=$$GET1^DIQ(399,IBIFN_",",248,"E")
+13 IF (IBX1_IBX2_IBX3_IBX4)'=""
Begin DoDot:1
+14 SET IBTEXT(1,1)="Initial TX Date: "_IBX1
+15 SET IBTEXT(1,2)="Last XRAY Date: "_IBX2
+16 SET IBTEXT(2,1)="Acute Manifestation Date: "_IBX3
+17 SET IBTEXT(2,2)="Condition Code: "_IBX4
+18 DO LINE^IBVCB(.IBTEXT)
+19 QUIT
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 SET IBTEXT(1,1)="*** No Chiropractic Data Found ***"
+22 DO LINE^IBVCB(.IBTEXT)
+23 QUIT
End DoDot:1
+24 ;
+25 SET IBTEXT(1,1)=""
+26 SET IBTEXT(2,1)="Ambulance Data"
+27 SET IBTEXT(3,1)="--------------"
+28 DO LINE^IBVCB(.IBTEXT)
+29 ;
+30 SET IBADD1=$$GET1^DIQ(399,IBIFN_",",271,"E")
+31 SET IBADD2=$$GET1^DIQ(399,IBIFN_",",272,"E")
+32 SET IBCITY=$$GET1^DIQ(399,IBIFN_",",273,"E")
+33 SET IBSTATE=$$GET1^DIQ(399,IBIFN_",",274,"E")
+34 SET IBZIP=$$GET1^DIQ(399,IBIFN_",",275,"E")
+35 SET IBPUADD=IBADD1_" "_IBADD2_" "_IBCITY_" "_IBSTATE_" "_IBZIP
+36 ;
+37 SET IBTEXT(1,1)="D/O Location: "_$$GET1^DIQ(399,IBIFN_",",276,"E")
+38 SET IBADD1=$$GET1^DIQ(399,IBIFN_",",277,"E")
+39 SET IBADD2=$$GET1^DIQ(399,IBIFN_",",278,"E")
+40 SET IBCITY=$$GET1^DIQ(399,IBIFN_",",279,"E")
+41 SET IBSTATE=$$GET1^DIQ(399,IBIFN_",",280,"E")
+42 SET IBZIP=$$GET1^DIQ(399,IBIFN_",",281,"E")
+43 SET IBDOADD=IBADD1_" "_IBADD2_" "_IBCITY_" "_IBSTATE_" "_IBZIP
+44 ;
+45 SET IBX1=$$GET1^DIQ(399,IBIFN_",",287,"E")
+46 SET IBX2=$$GET1^DIQ(399,IBIFN_",",289,"E")
+47 SET IBX3=$$GET1^DIQ(399,IBIFN_",",288,"E")
+48 SET IBX4=$$GET1^DIQ(399,IBIFN_",",290,"E")
+49 SET IBX5=$$GET1^DIQ(399,IBIFN_",",291,"E")
+50 ;
+51 IF (IBPUADD_IBDOADD_IBX1_IBX2_IBX3_IBX4_IBX5)'=""
Begin DoDot:1
+52 SET IBTEXT(1,1)="P/U Address: "_IBPUADD
+53 SET IBTEXT(2,1)="D/O Address: "_IBDOADD
+54 SET IBTEXT(3,1)="Pt. Weight: "_IBX1
+55 SET IBTEXT(3,2)="Transport Distance: "_IBX2
+56 SET IBTEXT(4,1)="Transport Reason: "_IBX3
+57 SET IBTEXT(5,1)="R/T Purpose: "_IBX4
+58 SET IBTEXT(6,1)="Stretcher Purpose: "_IBX5
+59 DO LINE^IBVCB(.IBTEXT)
+60 QUIT
End DoDot:1
+61 IF '$TEST
Begin DoDot:1
+62 SET IBTEXT(1,1)="*** No Ambulance Data Found ***"
+63 DO LINE^IBVCB(.IBTEXT)
+64 QUIT
End DoDot:1
+65 ;
+66 SET IBTEXT(1,1)=""
+67 SET IBTEXT(2,1)="Ambulance Conditions"
+68 SET IBTEXT(3,1)="--------------------"
+69 DO LINE^IBVCB(.IBTEXT)
+70 ;
+71 SET IBFIND=0
SET IBX=0
+72 FOR
SET IBX=$ORDER(^DGCR(399,IBIFN,"U9",IBX))
if 'IBX
QUIT
Begin DoDot:1
+73 SET IBFIND=1
+74 SET IBTEXT(1,1)="Ambulance Condition: "_$$GET1^DIQ(399.0292,IBX_","_IBIFN_",",.01,"E")
+75 DO LINE^IBVCB(.IBTEXT)
+76 QUIT
End DoDot:1
+77 IF 'IBFIND
Begin DoDot:1
+78 SET IBTEXT(2,1)="*** No Ambulance Conditions Found ***"
+79 DO LINE^IBVCB(.IBTEXT)
+80 QUIT
End DoDot:1
+81 ;
+82 SET IBTEXT(1,1)=""
+83 SET IBTEXT(2,1)="Property & Casualty Data"
+84 SET IBTEXT(3,1)="------------------------"
+85 DO LINE^IBVCB(.IBTEXT)
+86 ;
+87 SET IBX1=$$GET1^DIQ(399,IBIFN_",",261,"E")
+88 SET IBX2=$$GET1^DIQ(399,IBIFN_",",262,"E")
+89 SET IBX3=$$GET1^DIQ(399,IBIFN_",",268,"E")
+90 SET IBX4=$$GET1^DIQ(399,IBIFN_",",269,"E")
+91 SET IBX5=$$GET1^DIQ(399,IBIFN_",",269.1,"E")
+92 ;
+93 IF (IBX1_IBX2_IBX3_IBX4)'=""
Begin DoDot:1
+94 SET IBTEXT(1,1)="Claim Number: "_IBX1
+95 SET IBTEXT(1,2)="Date First Contact: "_IBX2
+96 SET IBTEXT(2,1)="Contact Name: "_IBX3
+97 SET IBTEXT(2,2)="Communication No.: "_IBX4_$SELECT(IBX5'="":" Ext."_IBX5,1:"")
+98 DO LINE^IBVCB(.IBTEXT)
+99 QUIT
End DoDot:1
+100 IF '$TEST
Begin DoDot:1
+101 SET IBTEXT(1,1)="*** No Property & Casualty Data Found ***"
+102 DO LINE^IBVCB(.IBTEXT)
+103 QUIT
End DoDot:1
+104 ;
+105 SET IBTEXT(1,1)=""
+106 SET IBTEXT(2,1)="Claim Level Providers"
+107 SET IBTEXT(3,1)="---------------------"
+108 DO LINE^IBVCB(.IBTEXT)
+109 ;
+110 SET IBFIND=0
+111 FOR IBROLE=4,3,2,9,1,5
Begin DoDot:1
+112 SET IBROLEX=$SELECT(IBROLE=1:"Referring",IBROLE=2:"Operating",IBROLE=3:"Rendering",IBROLE=4:"Attending",IBROLE=5:"Supervising",IBROLE=9:"Other Oper.",1:"")
+113 SET IBPROV=0
+114 FOR
SET IBPROV=$ORDER(^DGCR(399,IBIFN,"PRV",IBPROV))
if 'IBPROV
QUIT
Begin DoDot:2
+115 IF IBROLE'=$PIECE(^DGCR(399,IBIFN,"PRV",IBPROV,0),U)
QUIT
+116 SET IBFIND=1
+117 ;
+118 SET IBTEXT(1,1)=IBROLEX_": "_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.02,"E")
+119 SET IBTEXT(1,2)="Credentials: "_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.03,"E")
+120 SET IBTEXT(2,1)="Specialty: "_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.08,"E")
+121 SET IBTEXT(2,2)="Taxonomy: "_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.15,"E")
+122 ;
+123 SET IBPROVID=$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.12,"E")_"/"_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.05,"E")
+124 SET IBTEXT(3,1)="Prim Payer Qual/ID: "_IBPROVID
+125 SET IBPROVID=$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.13,"E")_"/"_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.06,"E")
+126 SET IBTEXT(3,2)="Sec Payer Qual/ID: "_IBPROVID
+127 SET IBPROVID=$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.14,"E")_"/"_$$GET1^DIQ(399.0222,IBPROV_","_IBIFN_",",.07,"E")
+128 SET IBTEXT(4,1)="Tert Payer Qual/ID: "_IBPROVID
+129 DO LINE^IBVCB(.IBTEXT)
+130 ;
+131 QUIT
End DoDot:2
+132 QUIT
End DoDot:1
+133 IF 'IBFIND
Begin DoDot:1
+134 SET IBTEXT(5,1)="*** No Claim Level Providers Found ***"
+135 DO LINE^IBVCB(.IBTEXT)
+136 QUIT
End DoDot:1
+137 ;
+138 SET IBTEXT(1,1)=""
+139 SET IBTEXT(2,1)="Non-VA Facility Data - Fee"
+140 SET IBTEXT(3,1)="--------------------------"
+141 DO LINE^IBVCB(.IBTEXT)
+142 ;
+143 SET IBX1=$$GET1^DIQ(399,IBIFN_",",232,"E")
+144 SET IBX2=$$GET1^DIQ(399,IBIFN_",",233,"E")
+145 SET IBX3=$$GET1^DIQ(399,IBIFN_",",234,"E")
+146 SET IBX4=$$GET1^DIQ(399,IBIFN_",",244,"E")
+147 IF (IBX1_IBX2_IBX3_IBX4)'=""
Begin DoDot:1
+148 SET IBTEXT(1,1)="Facility: "_IBX1
+149 SET IBTEXT(1,2)="Care Type: "_IBX2
+150 SET IBTEXT(2,1)="Non-VA ID: "_IBX3
+151 SET IBTEXT(2,2)="Taxonomy: "_IBX4
+152 DO LINE^IBVCB(.IBTEXT)
+153 QUIT
End DoDot:1
+154 IF '$TEST
Begin DoDot:1
+155 SET IBTEXT(1,1)="*** No Non-VA Facility Data Found ***"
+156 DO LINE^IBVCB(.IBTEXT)
+157 QUIT
End DoDot:1
+158 ;
+159 SET IBTEXT(1,1)=""
+160 SET IBTEXT(2,1)="Comments/Signature Block"
+161 SET IBTEXT(3,1)="------------------------"
+162 DO LINE^IBVCB(.IBTEXT)
+163 ;
+164 SET IBX1=$$GET1^DIQ(399,IBIFN_",",400,"E")
+165 SET IBX2=$$GET1^DIQ(399,IBIFN_",",459,"E")
+166 SET IBX3=$$GET1^DIQ(399,IBIFN_",",402,"E")
+167 IF (IBX1_IBX2_IBX3)'=""
Begin DoDot:1
+168 SET IBTEXT(1,1)="Box 31 (CMS1500): "_IBX1
+169 SET IBTEXT(2,1)="Box 19 (CMS1500): "_IBX2
+170 SET IBTEXT(3,1)="FL 80 (UB04): "_IBX3
+171 DO LINE^IBVCB(.IBTEXT)
+172 QUIT
End DoDot:1
+173 IF '$TEST
Begin DoDot:1
+174 SET IBTEXT(1,1)="*** No Comments/Signature Block Data Found ***"
+175 DO LINE^IBVCB(.IBTEXT)
+176 QUIT
End DoDot:1
+177 ;
+178 SET IBTEXT(1,1)=""
+179 SET IBTEXT(2,1)="ECME Data"
+180 SET IBTEXT(3,1)="---------"
+181 DO LINE^IBVCB(.IBTEXT)
+182 ;
+183 SET IBX1=$$GET1^DIQ(399,IBIFN_",",460,"E")
+184 SET IBX2=$$GET1^DIQ(399,IBIFN_",",461,"E")
+185 IF (IBX1_IBX2)'=""
Begin DoDot:1
+186 SET IBTEXT(1,1)="ECME Number: "_IBX1
+187 SET IBTEXT(1,2)="ECME Approval: "_IBX2
+188 DO LINE^IBVCB(.IBTEXT)
+189 QUIT
End DoDot:1
+190 IF '$TEST
Begin DoDot:1
+191 SET IBTEXT(1,1)="*** No ECME Data Found ***"
+192 DO LINE^IBVCB(.IBTEXT)
+193 QUIT
End DoDot:1
+194 ;
+195 SET IBTEXT(1,1)=""
+196 SET IBTEXT(2,1)="EOB/MRA Data"
+197 SET IBTEXT(3,1)="------------"
+198 DO LINE^IBVCB(.IBTEXT)
+199 ;
+200 SET IBX1=$$GET1^DIQ(399,IBIFN_",",22,"E")
+201 SET IBX2=$$GET1^DIQ(399,IBIFN_",",24,"E")
+202 SET IBX3=$$GET1^DIQ(399,IBIFN_",",453,"E")
+203 SET IBX4=$$GET1^DIQ(399,IBIFN_",",454,"E")
+204 SET IBX5=$$GET1^DIQ(399,IBIFN_",",455,"E")
+205 IF (IBX1_IBX2_IBX3_IBX4_IBX5)'=""
Begin DoDot:1
+206 SET IBTEXT(1,1)="Date MRA Received: "_IBX1
+207 SET IBTEXT(1,2)="MRA Status: "_IBX2
+208 SET IBTEXT(2,1)="Primary ICN: "_IBX3
+209 SET IBTEXT(2,2)="Secondary ICN: "_IBX4
+210 SET IBTEXT(3,1)="Tertiary ICN: "_IBX5
+211 DO LINE^IBVCB(.IBTEXT)
+212 QUIT
End DoDot:1
+213 IF '$TEST
Begin DoDot:1
+214 SET IBTEXT(1,1)="*** No EOB/MRA Data Found ***"
+215 DO LINE^IBVCB(.IBTEXT)
+216 QUIT
End DoDot:1
+217 ;
+218 SET IBTEXT(1,1)=""
+219 SET IBTEXT(2,1)="PRV Diagnosis Codes"
+220 SET IBTEXT(3,1)="-------------------"
+221 DO LINE^IBVCB(.IBTEXT)
+222 ;
+223 SET IBX1=$$GET1^DIQ(399,IBIFN_",",249,"E")
+224 SET IBX2=$$GET1^DIQ(399,IBIFN_",",250,"E")
+225 SET IBX3=$$GET1^DIQ(399,IBIFN_",",251,"E")
+226 IF (IBX1_IBX2_IBX3)'=""
Begin DoDot:1
+227 SET IBTEXT(1,1)="PRV #1: "_IBX1
+228 SET IBTEXT(1,2)="PRV #2: "_IBX2
+229 SET IBTEXT(2,1)="PRV #3: "_IBX3
+230 DO LINE^IBVCB(.IBTEXT)
+231 QUIT
End DoDot:1
+232 IF '$TEST
Begin DoDot:1
+233 SET IBTEXT(1,1)="*** No PRV Diagnosis Code Found ***"
+234 DO LINE^IBVCB(.IBTEXT)
+235 QUIT
End DoDot:1
+236 ;
+237 SET IBTEXT(1,1)=""
+238 SET IBTEXT(2,1)="Comments"
+239 SET IBTEXT(3,1)="--------"
+240 DO LINE^IBVCB(.IBTEXT)
+241 ;
+242 SET IBFIND=0
SET IBCOM1=0
+243 FOR
SET IBCOM1=$ORDER(^DGCR(399,IBIFN,"TXC",IBCOM1))
if 'IBCOM1
QUIT
Begin DoDot:1
+244 SET IBCOM2=0
+245 FOR
SET IBCOM2=$ORDER(^DGCR(399,IBIFN,"TXC",IBCOM1,1,IBCOM2))
if 'IBCOM2
QUIT
Begin DoDot:2
+246 SET IBFIND=1
+247 SET IBTEXT(1,1)="MRA WL Comments: "_$$GET1^DIQ(399.0771,IBCOM2_","_IBCOM1_","_IBIFN_",",.01,"E")
+248 SET IBTEXT(2,1)="MRA WL Comments Date: "_$$GET1^DIQ(399.077,IBCOM1_","_IBIFN_",",.01,"E")
+249 SET IBTEXT(2,2)="Entered By: "_$$GET1^DIQ(399.077,IBCOM1_","_IBIFN_",",.02,"E")
+250 DO LINE^IBVCB(.IBTEXT)
+251 QUIT
End DoDot:2
+252 QUIT
End DoDot:1
+253 IF 'IBFIND
Begin DoDot:1
+254 SET IBTEXT(1,1)="*** No MRA WL Comments Found ***"
+255 DO LINE^IBVCB(.IBTEXT)
+256 QUIT
End DoDot:1
+257 ;
+258 SET IBFIND=0
SET IBCOM1=0
+259 FOR
SET IBCOM1=$ORDER(^DGCR(399,IBIFN,"TXC2",IBCOM1))
if 'IBCOM1
QUIT
Begin DoDot:1
+260 SET IBCOM2=0
+261 FOR
SET IBCOM2=$ORDER(^DGCR(399,IBIFN,"TXC2",IBCOM1,1,IBCOM2))
if 'IBCOM2
QUIT
Begin DoDot:2
+262 SET IBFIND=1
+263 SET IBTEXT(1,1)="COB WL Comments: "_$$GET1^DIQ(399.0781,IBCOM2_","_IBCOM1_","_IBIFN_",",.01,"E")
+264 SET IBTEXT(2,1)="COB WL Comments Date: "_$$GET1^DIQ(399.078,IBCOM1_","_IBIFN_",",.01,"E")
+265 SET IBTEXT(2,2)="Entered By: "_$$GET1^DIQ(399.078,IBCOM1_","_IBIFN_",",.02,"E")
+266 DO LINE^IBVCB(.IBTEXT)
+267 QUIT
End DoDot:2
+268 QUIT
End DoDot:1
+269 IF 'IBFIND
Begin DoDot:1
+270 SET IBTEXT(1,1)="*** No COB WL Comments Found ***"
+271 DO LINE^IBVCB(.IBTEXT)
+272 QUIT
End DoDot:1
+273 ;
+274 SET IBTEXT(1,1)=""
+275 SET IBTEXT(2,1)="Referral/Authorization Code"
+276 SET IBTEXT(3,1)="---------------------------"
+277 DO LINE^IBVCB(.IBTEXT)
+278 ;
+279 SET IBX1=$$GET1^DIQ(399,IBIFN_",",163,"E")
+280 SET IBX2=$$GET1^DIQ(399,IBIFN_",",230,"E")
+281 SET IBX3=$$GET1^DIQ(399,IBIFN_",",231,"E")
+282 SET IBX4=$$GET1^DIQ(399,IBIFN_",",253,"E")
+283 SET IBX5=$$GET1^DIQ(399,IBIFN_",",254,"E")
+284 SET IBX6=$$GET1^DIQ(399,IBIFN_",",255,"E")
+285 IF (IBX1_IBX2_IBX3_IBX4_IBX5_IBX6)'=""
Begin DoDot:1
+286 SET IBTEXT(1,1)="A/Primary: "_IBX1
+287 SET IBTEXT(1,2)="A/Secondary: "_IBX2
+288 SET IBTEXT(2,1)="A/Tertiary: "_IBX3
+289 SET IBTEXT(2,2)="R/Primary: "_IBX4
+290 SET IBTEXT(3,1)="R/Secondary: "_IBX5
+291 SET IBTEXT(3,2)="R/Tertiary: "_IBX6
+292 DO LINE^IBVCB(.IBTEXT)
+293 QUIT
End DoDot:1
+294 IF '$TEST
Begin DoDot:1
+295 SET IBTEXT(1,1)="*** No Referral/Authorization Code Data Found ***"
+296 DO LINE^IBVCB(.IBTEXT)
+297 QUIT
End DoDot:1
+298 ;
+299 SET IBTEXT(1,1)=""
+300 SET IBTEXT(2,1)="Revenue Codes"
+301 SET IBTEXT(3,1)="-------------"
+302 DO LINE^IBVCB(.IBTEXT)
+303 ;
+304 SET IBFIND=0
SET IBREVCD=0
+305 FOR
SET IBREVCD=$ORDER(^DGCR(399,IBIFN,"RC",IBREVCD))
if 'IBREVCD
QUIT
Begin DoDot:1
+306 ; Print a blank line if this is not the first revenue code.
+307 IF IBFIND
SET IBTEXT(1,1)=""
DO LINE^IBVCB(.IBTEXT)
+308 SET IBFIND=1
+309 SET IBTEXT(1,1)="Code: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.01,"E")
+310 SET IBTEXT(1,2)="Number: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.001,"E")
+311 ;
+312 SET IBTEXT(2,1)="Charges: "_$$DOLLAR^IBVCB($$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.02,"E"))
+313 SET IBTEXT(2,2)="Units: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.03,"E")
+314 ;
+315 SET IBTEXT(3,1)="Total Charges: "_$$DOLLAR^IBVCB($$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.04,"E"))
+316 SET IBTEXT(3,2)="Bedsection: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.05,"E")
+317 ;
+318 SET IBTEXT(4,1)="Procedure: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.06,"E")
+319 SET IBTEXT(4,2)="RX Procedure: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.15,"E")
+320 ;
+321 SET IBTEXT(5,1)="Division: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.07,"E")
+322 SET IBTEXT(5,2)="Type: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.1,"E")
+323 ;
+324 SET IBTEXT(6,1)="Non-covered Charges: "_$$DOLLAR^IBVCB($$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.09,"E"))
+325 SET IBTEXT(6,2)="Component: "_$$GET1^DIQ(399.042,IBREVCD_","_IBIFN_",",.12,"E")
+326 DO LINE^IBVCB(.IBTEXT)
+327 ;
+328 QUIT
End DoDot:1
+329 IF 'IBFIND
Begin DoDot:1
+330 SET IBTEXT(1,1)="*** No Revenue Codes Found ***"
+331 DO LINE^IBVCB(.IBTEXT)
+332 QUIT
End DoDot:1
+333 ;
+334 QUIT
+335 ;
