IBCEMSR6 ;ALB/VAD - IB PRINTED CLAIMS REPORT - Sort ;09-SEP-2015
;;2.0;INTEGRATED BILLING;**547,759**;21-MAR-94;Build 24
;;Per VA Directive 6402, this routine should not be modified.
;
SRCH ; Collect Information
; Use the existing AP x-ref to narrow down the list of claims by date,
; then check field 27 to see if it's appropriate to put it on the report (1=LOCAL PRINT)
;The following line is used to find Bills in the Printed Date Range and the FORCE TO PRINT field
N BILLNO,IBBILZ,IBDV,IBDT,IBIFN,IBFTYP,IBTOP,IBRTN,IBRVCDS,IBSRT,IBTYPE,INSADD,LOCCNT,RCX,TOTCNT
N INSCO,IBSFLD,IBULD,IBINS,X,RTDSC,IBRVCD,IBTOPN,VARRAY,IBRTDS,IBPTYP,IBBLLR
K ^TMP($J,"IBCEMSRP-DATA")
D INIT
S IBDT=IBBDT-.1,IBSRT=$P(IBSORT,U)
S (TOTCNT,LOCCNT)=0
F S IBDT=$O(^DGCR(399,"AP",IBDT)) Q:'IBDT!(IBDT>IBEDT) D ; Identify those claims within the selected date range
. S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AP",IBDT,IBIFN)) Q:'IBIFN D
. . S IBBILZ=$G(^DGCR(399,IBIFN,0)),IBRTN=$P(IBBILZ,U,7),IBDV=+$P(IBBILZ,U,22) ; Get Rate Type and division
. . Q:$P(IBBILZ,U,13)'=4 ; don't include canceled claims
. . Q:'$D(IBDIVS(IBDV)) ; Not one of the selected Divisions
. . S TOTCNT=TOTCNT+1 ; Accumulate Total Printed for selected divisions.
. . I $P($G(^DGCR(399,IBIFN,"TX")),U,8)'=1 Q ; Is the Bill "FORCE LOCAL PRINT"?
. . ; don't include US Labor Dept claims; 5/1/23;IB*2.0*759v2;EBILL-3377;Patient resp claims may have no insurance, Q:IBINS=""
. . S IBINS=$$CURR^IBCEF2(IBIFN) Q:IBINS="" Q:$D(VARRAY("IBULD",IBINS))
. . ; don't count claims where EDI is inactive (user has to print those)
. . Q:$$INSOK^IBCEF4(IBINS)'=1
. . Q:'$D(VARRAY("RTYPES",IBRTN)) ;Is this one of the selected Rate Types?
. . S IBTOP=+$P($G(^IBA(355.3,+$$POLICY^IBCEF(IBIFN,18),0)),U,9) ; Get Plan Type
. . Q:'$D(VARRAY("IBTOP",IBTOP)) ;Is this one of the selected Plan Types?
. . S RCX=0
. . S (IBRVCDS,X)="" F S X=$O(^DGCR(399,IBIFN,"RC","B",X)) Q:X="" D Q:RCX
. . . I $D(VARRAY("XRVCDS",X)) S RCX=1 Q ; Bill contains a Revenue Code Exclusion.
. . . S IBRVCDS=$S(IBRVCDS="":X,1:IBRVCDS_","_X) ; Get Revenue Codes.
. . Q:RCX=1 ; bill contains at least one of the excluded revenue codes
. . S LOCCNT=LOCCNT+1 ; Accumulate Only Locally Printed that could have gone electronically and meet all the search criteria.
. . S IBRTDS=$G(VARRAY("RTYPES",IBRTN)) ; Get the Rate Type Description
. . S IBPTYP=$G(VARRAY("IBTOP",IBTOP)) ; Get Plan Type name
. . S BILLNO=$$BN1^PRCAFN(IBIFN) ; Get external CLAIM # DBIA #380
. . S INSCO=$P($G(^DIC(36,IBINS,0)),U) ; Get Insurance Company Name
. . S INSADD=$$CURRINS^IBCEPTC2(IBIFN) ; Get Insurance Company Address
. . S IBFTYP=$P($G(^IBE(353,+$P(IBBILZ,U,19),0)),U) I IBFTYP="" S IBFTYP="UNKNOWN" ; Get the Bill's Form Type.
. . S IBTYPE=$S($P(IBBILZ,U,5)>2:"O",1:"I")_"/"_$S($P(IBBILZ,U,27)=1:"I",$P(IBBILZ,U,27)=2:"P",1:"") ; Patient Status / Bill Charge Type
. . S IBBLLR=$P($$BILLER^IBCIUT5(IBIFN),U,2) ; Get Biller
. . ; GATHER REPORTABLE DATA AND STORE ACCORDING TO THE VALUE OF IBSORT INTO ^TMP($J,"IBCEMSRP-DATA")!!!
. . S IBSFLD=$S(IBSRT="I":INSCO,IBSRT="R":IBRTDS,IBSRT="F":IBFTYP,IBSRT="P":IBPTYP,1:IBBLLR)
. . ; if sorted by insurance company, add address to subheader
. . S:IBSRT="I" ^TMP($J,"IBCEMSRP-DATA",INSCO)=INSADD
. . S ^TMP($J,"IBCEMSRP-DATA",IBSFLD,BILLNO)=IBTYPE_U_IBRTDS_U_IBPTYP_U_$G(IBDIVS(IBDV))_U_IBBLLR_U_INSCO_U_INSADD
. . S ^TMP($J,"IBCEMSRP-DATA",IBSFLD,BILLNO,"RVCDS")=IBRVCDS
S ^TMP($J,"IBCEMSRP-DATA")=LOCCNT_U_TOTCNT
Q
;
INIT ; come here to set up search criteria
; Get ien of US Labor Department payer (cover all possible name variations)
S IBULD=$O(^DIC(36,"B","US LABOR DEPARTMENT","")) S:IBULD'="" VARRAY("IBULD",IBULD)=""
S IBULD=$O(^DIC(36,"B","US DEPT OF LABOR","")) S:IBULD'="" VARRAY("IBULD",IBULD)=""
S IBULD=$O(^DIC(36,"B","US DEPARTMENT OF LABOR","")) S:IBULD'="" VARRAY("IBULD",IBULD)=""
; handle claims that do not have a type of plan
S VARRAY("IBTOP",0)="UNKNOWN"
; Claim does not contain excluded revenue codes from IB Site parameters
S IBRVCD="" F S IBRVCD=$O(^IBE(350.9,1,15,"B",IBRVCD)) Q:'IBRVCD S VARRAY("XRVCDS",IBRVCD)=""
; Tricare Rate Type is one of the following and type of plan is one of the following:
I IBCOT="T" D Q
.F RTDSC="CHAMPVA REIMB. INS.","CHAMPVA","TRICARE REIMB. INS.","TRICARE" S IBRTN=$O(^DGCR(399.3,"B",RTDSC,"")) I IBRTN S VARRAY("RTYPES",IBRTN)=RTDSC
.F IBTOPN="TRICARE","CHAMPVA","TRICARE SUPPLEMENTAL" S IBTOP=$O(^IBE(355.1,"B",IBTOPN,"")) I IBTOP S VARRAY("IBTOP",IBTOP)=IBTOPN
; CPAC Rate Type is one of the following and type of plan is one of the following:
I IBCOT="C" D Q
.F RTDSC="CRIME VICTIM","NO FAULT INS.","REIMBURSABLE INS.","TORT FEASOR","WORKERS' COMP." S IBRTN=$O(^DGCR(399.3,"B",RTDSC,"")) I IBRTN S VARRAY("RTYPES",IBRTN)=RTDSC
.F IBTOPN="ACCIDENT AND HEALTH INSURANCE","AUTOMOBILE","CARVE-OUT","CATASTROPHIC INSURANCE","COMPREHENSIVE MAJOR MEDICAL" S IBTOP=$O(^IBE(355.1,"B",IBTOPN,"")) I IBTOP S VARRAY("IBTOP",IBTOP)=IBTOPN
.F IBTOPN="HEALTH MAINTENANCE ORGANIZ","INCOME PROTECTION (INDEMNITY)","INDIVIDUAL PRACTICE ASSOCATION (IPA)" S IBTOP=$O(^IBE(355.1,"B",IBTOPN,"")) I IBTOP S VARRAY("IBTOP",IBTOP)=IBTOPN
.F IBTOPN="INPATIENT (BASIC HOSPITAL)","LABS, PROCEDURES, X-RAY, ETC. (ONLY)","MANAGED CARE SYSTEM (MCS)","MEDI-CAL","MEDICAID" S IBTOP=$O(^IBE(355.1,"B",IBTOPN,"")) I IBTOP S VARRAY("IBTOP",IBTOP)=IBTOPN
.F IBTOPN="MEDICAL EXPENSE (OPT/PROF)","MEDICARE SECONDARY (B EXC)","MEDICARE SECONDARY (NO B EXC)","MEDICARE SUPPLEMENTAL" S IBTOP=$O(^IBE(355.1,"B",IBTOPN,"")) I IBTOP S VARRAY("IBTOP",IBTOP)=IBTOPN
.F IBTOPN="MEDICARE/MEDICAID (MEDI-CAL)","MEDIGAP PLAN A","MEDIGAP PLAN B","MEDIGAP PLAN C","MEDIGAP PLAN D","MEDIGAP PLAN F" S IBTOP=$O(^IBE(355.1,"B",IBTOPN,"")) I IBTOP S VARRAY("IBTOP",IBTOP)=IBTOPN
.F IBTOPN="MEDIGAP PLAN G","MEDIGAP PLAN K","MEDIGAP PLAN L","MEDIGAP PLAN M","MEDIGAP PLAN N","MENTAL HEALTH","POINT OF SERVICE" S IBTOP=$O(^IBE(355.1,"B",IBTOPN,"")) I IBTOP S VARRAY("IBTOP",IBTOP)=IBTOPN
.F IBTOPN="PREFERRED PROVIDER ORGANIZATION (PPO)","PREPAID GROUP PRACTICE PLAN","PRESCRIPTION","RETIREE","SPECIAL CLASS INSURANCE" S IBTOP=$O(^IBE(355.1,"B",IBTOPN,"")) I IBTOP S VARRAY("IBTOP",IBTOP)=IBTOPN
.F IBTOPN="SPECIAL RISK INSURANCE","SPECIFIED DISEASE INSURANCE","SURGICAL EXPENSE INSURANCE","WORKERS' COMPENSATION INSURANCE" S IBTOP=$O(^IBE(355.1,"B",IBTOPN,"")) I IBTOP S VARRAY("IBTOP",IBTOP)=IBTOPN
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMSR6 6517 printed Apr 09, 2024@21:16:51 Page 2
IBCEMSR6 ;ALB/VAD - IB PRINTED CLAIMS REPORT - Sort ;09-SEP-2015
+1 ;;2.0;INTEGRATED BILLING;**547,759**;21-MAR-94;Build 24
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
SRCH ; Collect Information
+1 ; Use the existing AP x-ref to narrow down the list of claims by date,
+2 ; then check field 27 to see if it's appropriate to put it on the report (1=LOCAL PRINT)
+3 ;The following line is used to find Bills in the Printed Date Range and the FORCE TO PRINT field
+4 NEW BILLNO,IBBILZ,IBDV,IBDT,IBIFN,IBFTYP,IBTOP,IBRTN,IBRVCDS,IBSRT,IBTYPE,INSADD,LOCCNT,RCX,TOTCNT
+5 NEW INSCO,IBSFLD,IBULD,IBINS,X,RTDSC,IBRVCD,IBTOPN,VARRAY,IBRTDS,IBPTYP,IBBLLR
+6 KILL ^TMP($JOB,"IBCEMSRP-DATA")
+7 DO INIT
+8 SET IBDT=IBBDT-.1
SET IBSRT=$PIECE(IBSORT,U)
+9 SET (TOTCNT,LOCCNT)=0
+10 ; Identify those claims within the selected date range
FOR
SET IBDT=$ORDER(^DGCR(399,"AP",IBDT))
if 'IBDT!(IBDT>IBEDT)
QUIT
Begin DoDot:1
+11 SET IBIFN=0
FOR
SET IBIFN=$ORDER(^DGCR(399,"AP",IBDT,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:2
+12 ; Get Rate Type and division
SET IBBILZ=$GET(^DGCR(399,IBIFN,0))
SET IBRTN=$PIECE(IBBILZ,U,7)
SET IBDV=+$PIECE(IBBILZ,U,22)
+13 ; don't include canceled claims
if $PIECE(IBBILZ,U,13)'=4
QUIT
+14 ; Not one of the selected Divisions
if '$DATA(IBDIVS(IBDV))
QUIT
+15 ; Accumulate Total Printed for selected divisions.
SET TOTCNT=TOTCNT+1
+16 ; Is the Bill "FORCE LOCAL PRINT"?
IF $PIECE($GET(^DGCR(399,IBIFN,"TX")),U,8)'=1
QUIT
+17 ; don't include US Labor Dept claims; 5/1/23;IB*2.0*759v2;EBILL-3377;Patient resp claims may have no insurance, Q:IBINS=""
+18 SET IBINS=$$CURR^IBCEF2(IBIFN)
if IBINS=""
QUIT
if $DATA(VARRAY("IBULD",IBINS))
QUIT
+19 ; don't count claims where EDI is inactive (user has to print those)
+20 if $$INSOK^IBCEF4(IBINS)'=1
QUIT
+21 ;Is this one of the selected Rate Types?
if '$DATA(VARRAY("RTYPES",IBRTN))
QUIT
+22 ; Get Plan Type
SET IBTOP=+$PIECE($GET(^IBA(355.3,+$$POLICY^IBCEF(IBIFN,18),0)),U,9)
+23 ;Is this one of the selected Plan Types?
if '$DATA(VARRAY("IBTOP",IBTOP))
QUIT
+24 SET RCX=0
+25 SET (IBRVCDS,X)=""
FOR
SET X=$ORDER(^DGCR(399,IBIFN,"RC","B",X))
if X=""
QUIT
Begin DoDot:3
+26 ; Bill contains a Revenue Code Exclusion.
IF $DATA(VARRAY("XRVCDS",X))
SET RCX=1
QUIT
+27 ; Get Revenue Codes.
SET IBRVCDS=$SELECT(IBRVCDS="":X,1:IBRVCDS_","_X)
End DoDot:3
if RCX
QUIT
+28 ; bill contains at least one of the excluded revenue codes
if RCX=1
QUIT
+29 ; Accumulate Only Locally Printed that could have gone electronically and meet all the search criteria.
SET LOCCNT=LOCCNT+1
+30 ; Get the Rate Type Description
SET IBRTDS=$GET(VARRAY("RTYPES",IBRTN))
+31 ; Get Plan Type name
SET IBPTYP=$GET(VARRAY("IBTOP",IBTOP))
+32 ; Get external CLAIM # DBIA #380
SET BILLNO=$$BN1^PRCAFN(IBIFN)
+33 ; Get Insurance Company Name
SET INSCO=$PIECE($GET(^DIC(36,IBINS,0)),U)
+34 ; Get Insurance Company Address
SET INSADD=$$CURRINS^IBCEPTC2(IBIFN)
+35 ; Get the Bill's Form Type.
SET IBFTYP=$PIECE($GET(^IBE(353,+$PIECE(IBBILZ,U,19),0)),U)
IF IBFTYP=""
SET IBFTYP="UNKNOWN"
+36 ; Patient Status / Bill Charge Type
SET IBTYPE=$SELECT($PIECE(IBBILZ,U,5)>2:"O",1:"I")_"/"_$SELECT($PIECE(IBBILZ,U,27)=1:"I",$PIECE(IBBILZ,U,27)=2:"P",1:"")
+37 ; Get Biller
SET IBBLLR=$PIECE($$BILLER^IBCIUT5(IBIFN),U,2)
+38 ; GATHER REPORTABLE DATA AND STORE ACCORDING TO THE VALUE OF IBSORT INTO ^TMP($J,"IBCEMSRP-DATA")!!!
+39 SET IBSFLD=$SELECT(IBSRT="I":INSCO,IBSRT="R":IBRTDS,IBSRT="F":IBFTYP,IBSRT="P":IBPTYP,1:IBBLLR)
+40 ; if sorted by insurance company, add address to subheader
+41 if IBSRT="I"
SET ^TMP($JOB,"IBCEMSRP-DATA",INSCO)=INSADD
+42 SET ^TMP($JOB,"IBCEMSRP-DATA",IBSFLD,BILLNO)=IBTYPE_U_IBRTDS_U_IBPTYP_U_$GET(IBDIVS(IBDV))_U_IBBLLR_U_INSCO_U_INSADD
+43 SET ^TMP($JOB,"IBCEMSRP-DATA",IBSFLD,BILLNO,"RVCDS")=IBRVCDS
End DoDot:2
End DoDot:1
+44 SET ^TMP($JOB,"IBCEMSRP-DATA")=LOCCNT_U_TOTCNT
+45 QUIT
+46 ;
INIT ; come here to set up search criteria
+1 ; Get ien of US Labor Department payer (cover all possible name variations)
+2 SET IBULD=$ORDER(^DIC(36,"B","US LABOR DEPARTMENT",""))
if IBULD'=""
SET VARRAY("IBULD",IBULD)=""
+3 SET IBULD=$ORDER(^DIC(36,"B","US DEPT OF LABOR",""))
if IBULD'=""
SET VARRAY("IBULD",IBULD)=""
+4 SET IBULD=$ORDER(^DIC(36,"B","US DEPARTMENT OF LABOR",""))
if IBULD'=""
SET VARRAY("IBULD",IBULD)=""
+5 ; handle claims that do not have a type of plan
+6 SET VARRAY("IBTOP",0)="UNKNOWN"
+7 ; Claim does not contain excluded revenue codes from IB Site parameters
+8 SET IBRVCD=""
FOR
SET IBRVCD=$ORDER(^IBE(350.9,1,15,"B",IBRVCD))
if 'IBRVCD
QUIT
SET VARRAY("XRVCDS",IBRVCD)=""
+9 ; Tricare Rate Type is one of the following and type of plan is one of the following:
+10 IF IBCOT="T"
Begin DoDot:1
+11 FOR RTDSC="CHAMPVA REIMB. INS.","CHAMPVA","TRICARE REIMB. INS.","TRICARE"
SET IBRTN=$ORDER(^DGCR(399.3,"B",RTDSC,""))
IF IBRTN
SET VARRAY("RTYPES",IBRTN)=RTDSC
+12 FOR IBTOPN="TRICARE","CHAMPVA","TRICARE SUPPLEMENTAL"
SET IBTOP=$ORDER(^IBE(355.1,"B",IBTOPN,""))
IF IBTOP
SET VARRAY("IBTOP",IBTOP)=IBTOPN
End DoDot:1
QUIT
+13 ; CPAC Rate Type is one of the following and type of plan is one of the following:
+14 IF IBCOT="C"
Begin DoDot:1
+15 FOR RTDSC="CRIME VICTIM","NO FAULT INS.","REIMBURSABLE INS.","TORT FEASOR","WORKERS' COMP."
SET IBRTN=$ORDER(^DGCR(399.3,"B",RTDSC,""))
IF IBRTN
SET VARRAY("RTYPES",IBRTN)=RTDSC
+16 FOR IBTOPN="ACCIDENT AND HEALTH INSURANCE","AUTOMOBILE","CARVE-OUT","CATASTROPHIC INSURANCE","COMPREHENSIVE MAJOR MEDICAL"
SET IBTOP=$ORDER(^IBE(355.1,"B",IBTOPN,""))
IF IBTOP
SET VARRAY("IBTOP",IBTOP)=IBTOPN
+17 FOR IBTOPN="HEALTH MAINTENANCE ORGANIZ","INCOME PROTECTION (INDEMNITY)","INDIVIDUAL PRACTICE ASSOCATION (IPA)"
SET IBTOP=$ORDER(^IBE(355.1,"B",IBTOPN,""))
IF IBTOP
SET VARRAY("IBTOP",IBTOP)=IBTOPN
+18 FOR IBTOPN="INPATIENT (BASIC HOSPITAL)","LABS, PROCEDURES, X-RAY, ETC. (ONLY)","MANAGED CARE SYSTEM (MCS)","MEDI-CAL","MEDICAID"
SET IBTOP=$ORDER(^IBE(355.1,"B",IBTOPN,""))
IF IBTOP
SET VARRAY("IBTOP",IBTOP)=IBTOPN
+19 FOR IBTOPN="MEDICAL EXPENSE (OPT/PROF)","MEDICARE SECONDARY (B EXC)","MEDICARE SECONDARY (NO B EXC)","MEDICARE SUPPLEMENTAL"
SET IBTOP=$ORDER(^IBE(355.1,"B",IBTOPN,""))
IF IBTOP
SET VARRAY("IBTOP",IBTOP)=IBTOPN
+20 FOR IBTOPN="MEDICARE/MEDICAID (MEDI-CAL)","MEDIGAP PLAN A","MEDIGAP PLAN B","MEDIGAP PLAN C","MEDIGAP PLAN D","MEDIGAP PLAN F"
SET IBTOP=$ORDER(^IBE(355.1,"B",IBTOPN,""))
IF IBTOP
SET VARRAY("IBTOP",IBTOP)=IBTOPN
+21 FOR IBTOPN="MEDIGAP PLAN G","MEDIGAP PLAN K","MEDIGAP PLAN L","MEDIGAP PLAN M","MEDIGAP PLAN N","MENTAL HEALTH","POINT OF SERVICE"
SET IBTOP=$ORDER(^IBE(355.1,"B",IBTOPN,""))
IF IBTOP
SET VARRAY("IBTOP",IBTOP)=IBTOPN
+22 FOR IBTOPN="PREFERRED PROVIDER ORGANIZATION (PPO)","PREPAID GROUP PRACTICE PLAN","PRESCRIPTION","RETIREE","SPECIAL CLASS INSURANCE"
SET IBTOP=$ORDER(^IBE(355.1,"B",IBTOPN,""))
IF IBTOP
SET VARRAY("IBTOP",IBTOP)=IBTOPN
+23 FOR IBTOPN="SPECIAL RISK INSURANCE","SPECIFIED DISEASE INSURANCE","SURGICAL EXPENSE INSURANCE","WORKERS' COMPENSATION INSURANCE"
SET IBTOP=$ORDER(^IBE(355.1,"B",IBTOPN,""))
IF IBTOP
SET VARRAY("IBTOP",IBTOP)=IBTOPN
End DoDot:1
QUIT
+24 QUIT
+25 ;
