IBCBB8 ;ALB/BGA - CON'T MEDICARE EDIT CHECKS ;08/12/98
;;2.0;INTEGRATED BILLING;**51,137,210,349,373**;21-MAR-94;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; UB-04 CLAIM CERTIFICATE ID NUMBER
I '$$VALID(IBIFN) S IBQUIT=$$IBER^IBCBB3(.IBER,215) Q:IBQUIT
;
; Req. on Primary Payor when Medicare is secondary and value 12-15,43
I $$COBN^IBCEF(IBIFN)=2 D Q:IBQUIT
. I $O(IBVALCD(16),-1)'<12!$D(IBVALCD(43)) D
. . K IBXDATA D F^IBCEF("N-ALL INSURED EMPLOYER INFO",,,IBIFN)
. . ; employer name^city^state abbreviation^state ien
. . ;I '$O(IBXDATA(0)) S IBQUIT=$$IBER^IBCBB3(.IBER,222) Q
. . ; Employer name missing
. . ;I $P($G(IBXDATA(1)),U)="" S IBQUIT=$$IBER^IBCBB3(.IBER,222)
. . ; Employer address missing
. . ;I $TR($P($G(IBXDATA(1)),U,2,4),U)="" S IBQUIT=$$IBER^IBCBB3(.IBER,223)
. ;
. ; Insured's Group Number
. ; if Medicare is secondary, need insurance group number for primary
. K IBXDATA D F^IBCEF("N-ALL INSURANCE GROUP NUMBER",,,IBIFN)
. I $P($G(IBXDATA(1)),U)="" S IBQUIT=$$IBER^IBCBB3(.IBER,225)
;
; UB-04 Diagnosis Codes
K IBXDATA D F^IBCEF("N-DIAGNOSES",,,IBIFN)
;
S IBI=0
F S IBI=$O(IBXDATA(IBI)) Q:'IBI D Q:IBQUIT
. S IBDXC=$P($$ICD9^IBACSV(+$P(IBXDATA(IBI),U)),U)
. ; no duplicate dx
. I IBDXC'="",$D(IBDXARY(IBDXC)) S IBQUIT=$$IBER^IBCBB3(.IBER,227)
. I IBDXC'="",'$D(IBDXARY(IBDXC)) S IBDXARY(IBDXC)=IBXDATA(IBI)
Q:IBQUIT
;
Q
;
VALID(IBIFN) ; Verify HIC # is valid
N VAL,IBXDATA
S VAL=1
G:'$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) VALQ
;
K IBXDATA D F^IBCEF("N-CURR INSURED ID",,,IBIFN)
;
I $G(IBXDATA)="" S VAL=0 G VALQ
;
S IBXDATA=$TR(IBXDATA,"-")
; HIC # must pass standard MEDICARE edits
I '$$VALHIC^IBCNSMM(IBXDATA) S VAL=0
;
VALQ Q VAL
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBB8 1800 printed Dec 13, 2024@02:08:58 Page 2
IBCBB8 ;ALB/BGA - CON'T MEDICARE EDIT CHECKS ;08/12/98
+1 ;;2.0;INTEGRATED BILLING;**51,137,210,349,373**;21-MAR-94;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; UB-04 CLAIM CERTIFICATE ID NUMBER
+5 IF '$$VALID(IBIFN)
SET IBQUIT=$$IBER^IBCBB3(.IBER,215)
if IBQUIT
QUIT
+6 ;
+7 ; Req. on Primary Payor when Medicare is secondary and value 12-15,43
+8 IF $$COBN^IBCEF(IBIFN)=2
Begin DoDot:1
+9 IF $ORDER(IBVALCD(16),-1)'<12!$DATA(IBVALCD(43))
Begin DoDot:2
+10 KILL IBXDATA
DO F^IBCEF("N-ALL INSURED EMPLOYER INFO",,,IBIFN)
+11 ; employer name^city^state abbreviation^state ien
+12 ;I '$O(IBXDATA(0)) S IBQUIT=$$IBER^IBCBB3(.IBER,222) Q
+13 ; Employer name missing
+14 ;I $P($G(IBXDATA(1)),U)="" S IBQUIT=$$IBER^IBCBB3(.IBER,222)
+15 ; Employer address missing
+16 ;I $TR($P($G(IBXDATA(1)),U,2,4),U)="" S IBQUIT=$$IBER^IBCBB3(.IBER,223)
End DoDot:2
+17 ;
+18 ; Insured's Group Number
+19 ; if Medicare is secondary, need insurance group number for primary
+20 KILL IBXDATA
DO F^IBCEF("N-ALL INSURANCE GROUP NUMBER",,,IBIFN)
+21 IF $PIECE($GET(IBXDATA(1)),U)=""
SET IBQUIT=$$IBER^IBCBB3(.IBER,225)
End DoDot:1
if IBQUIT
QUIT
+22 ;
+23 ; UB-04 Diagnosis Codes
+24 KILL IBXDATA
DO F^IBCEF("N-DIAGNOSES",,,IBIFN)
+25 ;
+26 SET IBI=0
+27 FOR
SET IBI=$ORDER(IBXDATA(IBI))
if 'IBI
QUIT
Begin DoDot:1
+28 SET IBDXC=$PIECE($$ICD9^IBACSV(+$PIECE(IBXDATA(IBI),U)),U)
+29 ; no duplicate dx
+30 IF IBDXC'=""
IF $DATA(IBDXARY(IBDXC))
SET IBQUIT=$$IBER^IBCBB3(.IBER,227)
+31 IF IBDXC'=""
IF '$DATA(IBDXARY(IBDXC))
SET IBDXARY(IBDXC)=IBXDATA(IBI)
End DoDot:1
if IBQUIT
QUIT
+32 if IBQUIT
QUIT
+33 ;
+34 QUIT
+35 ;
VALID(IBIFN) ; Verify HIC # is valid
+1 NEW VAL,IBXDATA
+2 SET VAL=1
+3 if '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN))
GOTO VALQ
+4 ;
+5 KILL IBXDATA
DO F^IBCEF("N-CURR INSURED ID",,,IBIFN)
+6 ;
+7 IF $GET(IBXDATA)=""
SET VAL=0
GOTO VALQ
+8 ;
+9 SET IBXDATA=$TRANSLATE(IBXDATA,"-")
+10 ; HIC # must pass standard MEDICARE edits
+11 IF '$$VALHIC^IBCNSMM(IBXDATA)
SET VAL=0
+12 ;
VALQ QUIT VAL
+1 ;
