ABMDE8X1 ; IHS/ASDST/DMJ - Page 8 - ERROR CHECKS-CONT ;
;;2.6;IHS 3P BILLING SYSTEM;**8,9,13,14,21**;NOV 12, 2009;Build 379
;IHS/SD/SDR- v2.5 p8 task 6 - Added code for page 8K error checks; also added to page 8H error checks for ambulance billing
;IHS/SD/SDR- v2.5 p9 task 1 - Added code to check for provider address
;IHS/SD/SDR- v2.5 p10 IM20394 - Added code for new error 217
;IHS/SD/SDR- v2.5 p11 NPI - Added code for NPI errors 220 and 221
;
;IHS/SD/SDR- v2.6 CSV
;IHS/SD/SDR- 2.6*13 Added check for new export mode 35
;IHS/SD/SDR- 2.6*14 ICD10 008 - Added warning if service lines cross over ICD10 EFFECTIVE DATE
;IHS/SD/SDR- 2.6*14 HEAT163747 - Updated error 217 so it only displays one for ea service line, no matter how many coor dx are present
;IHS/SD/SDR- 2.6*21 HEAT135540 - Added error 200 so it will display if there is a 90 modifier but
; the referring CLIA is blank.
;
E1 ;EP - Entry Point Page 8E error checks cont
S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)
;start new abm*2.6*14 ICD10 008
S ABMP("SLFDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)),U,5)
S ABMP("SLTDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)),U,12)
I (ABMP("ICD10")>ABMP("SLFDT"))&(ABMP("ICD10")<ABMP("SLTDT")) S ABME(249)=$S($G(ABME(249))="":ABMX,1:$G(ABME(249))_","_ABMX)
;end new ICD10 008
I ^ABMDEXP(ABMMODE(5),0)["UB" D
.I $P(ABMX("X0"),U,2)="" S ABME(121)=""
I (^ABMDEXP(ABMMODE(5),0)["HCFA")!(^ABMDEXP(ABMMODE(5),0)["CMS") D
.I $P(ABMX("X0"),"^",9)="" S ABME(122)=""
.;start new abm*2.6*21 IHS/SD/SDR HEAT135540
.I $P(ABMX("X0"),U,6,8)["90",$P(ABMX("X0"),U,14)="" D
..I $G(ABME(200))'="" S ABME(200)=$G(ABME(200))_","_ABMX("I")
..I $G(ABME(200))="" S ABME(200)=ABMX("I")
.;end new abm*2.6*21 IHS/SD/SDR HEAT135540
.S ABMCODXS=$P(ABMX("X0"),U,9)
.I ABMCODXS'="" D
..F ABMJ=1:1 S ABMCODX=$P(ABMCODXS,",",ABMJ) Q:+$G(ABMCODX)=0 D
...;start new abm*2.6*8 NOHEAT
...;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") Q:ABME(217)[(ABMX("I")) S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))="") S ABME(217)=ABMX("I")
...;end new
I $P(ABMX("X0"),U,3)="" S ABME(123)=""
I $P(ABMX("X0"),U,4)="" S ABME(126)=""
I +$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",$P(ABMX("X0"),U),0))'=0 D
.Q:ABMMODE(5)'=22 ;837P only
.Q:'$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",$P(ABMX("X0"),U)))
.S ABMIIEN=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",$P(ABMX("X0"),U),0))
.Q:$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,ABMIIEN,0)),U,2)'="Y" ;quit if not required
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)),U,19)="" S ABME(233)=""
.I +$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)),U,21)=0 S ABME(233)="" ;lab result req'd
I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U)))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,2)),U,2)="") D ;abm*2.6*9 NARR
.Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010" ;abm*2.6*9 NARR
.K ABMP("CPTNT") S ABMP("CPTNT")=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U),0)) ;abm*2.6*9 NARR
.Q:($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y") ;abm*2.6*9 NARR
.S ABME(241)=$S('$D(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I")) ;abm*2.6*9 NARR
;I ABMMODE(5)=22!(ABMMODE(5)=27) D ;abm*2.6*13 export mode 35
I ABMMODE(5)=22!(ABMMODE(5)=27)!(ABMMODE(5)=35) D ;abm*2.6*13 export mode 35
.S ABMPIEN=0
.F S ABMPIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,"P",ABMPIEN)) Q:+ABMPIEN=0 D
..S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,"P",ABMPIEN,0)),U)
..;start new abm*2.6*8 NOHEAT
..I ABMNPIUS="N",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(220)=$S('$D(ABME(220)):ABMX("I"),1:ABME(220)_","_ABMX("I"))
..I ABMNPIUS="B",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(221)=$S('$D(ABME(221)):ABMX("I"),1:ABME(221)_","_ABMX("I"))
..;end new
..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,"P",ABMPIEN,0)),U,2)'="D"
..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,"P",ABMPIEN,0)),U)
..I $P($G(^VA(200,ABMPRV,.11)),U)="" S ABME(216)=ABMX ;provider street
..I $P($G(^VA(200,ABMPRV,.11)),U,4)="" S ABME(216)=ABMX ;city
..I $P($G(^VA(200,ABMPRV,.11)),U,5)="" S ABME(216)=ABMX ;state
..I $P($G(^VA(200,ABMPRV,.11)),U,6)="" S ABME(216)=ABMX ;zip
K ABMPIEN
Q
;
F1 ;EP - Entry Point Page 8F error checks cont
S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,0)
;start new abm*2.6*14 ICD10 008
S ABMP("SLFDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,0)),U,9)
S ABMP("SLTDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,0)),U,12)
I (ABMP("ICD10")>ABMP("SLFDT"))&(ABMP("ICD10")<ABMP("SLTDT")) S ABME(249)=$S($G(ABME(249))="":ABMX,1:$G(ABME(249))_","_ABMX)
;end new ICD10 008
I ^ABMDEXP(ABMMODE(6),0)["UB" D
.I $P(ABMX("X0"),U,2)="" S ABME(121)=""
I (^ABMDEXP(ABMMODE(6),0)["HCFA")!(^ABMDEXP(ABMMODE(6),0)["CMS") D
.I $P(ABMX("X0"),"^",8)="" S ABME(122)=""
.S ABMCODXS=$P(ABMX("X0"),U,8)
.I ABMCODXS'="" D
..F ABMJ=1:1 S ABMCODX=$P(ABMCODXS,",",ABMJ) Q:+$G(ABMCODX)=0 D
...;start new abm*2.6*8 NOHEAT
...;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") Q:ABME(217)[(ABMX("I")) S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))="") S ABME(217)=ABMX("I")
...;end new
I $P(ABMX("X0"),U,3)="" S ABME(123)=""
I $P(ABMX("X0"),U,4)="" S ABME(126)=""
I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U)))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,2)),U,2)="") D ;abm*2.6*9 NARR
.Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010" ;abm*2.6*9 NARR
.K ABMP("CPTNT") S ABMP("CPTNT")=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U),0)) ;abm*2.6*9 NARR
.Q:($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y") ;abm*2.6*9 NARR
.S ABME(241)=$S('$D(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I")) ;abm*2.6*9 NARR
;I ABMMODE(6)=22!(ABMMODE(6)=27) D ;abm*2.6*13 export mode 35
I ABMMODE(6)=22!(ABMMODE(6)=27)!(ABMMODE(6)=35) D ;abm*2.6*13 export mode 35
.S ABMPIEN=0
.F S ABMPIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,"P",ABMPIEN)) Q:+ABMPIEN=0 D
..S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,"P",ABMPIEN,0)),U)
..;start new abm*2.6*8 NOHEAT
..I ABMNPIUS="N",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(220)=$S('$D(ABME(220)):ABMX("I"),1:ABME(220)_","_ABMX("I"))
..I ABMNPIUS="B",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(221)=$S('$D(ABME(221)):ABMX("I"),1:ABME(221)_","_ABMX("I"))
..;end new
..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,"P",ABMPIEN,0)),U,2)'="D"
..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,"P",ABMPIEN,0)),U)
..I $P($G(^VA(200,ABMPRV,.11)),U)="" S ABME(216)=ABMX ;provider street
..I $P($G(^VA(200,ABMPRV,.11)),U,4)="" S ABME(216)=ABMX ;city
..I $P($G(^VA(200,ABMPRV,.11)),U,5)="" S ABME(216)=ABMX ;state
..I $P($G(^VA(200,ABMPRV,.11)),U,6)="" S ABME(216)=ABMX ;zip
K ABMPIEN
Q
;
G1 ;EP - Entry Point Page 8G error checks cont
S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,0)
I ^ABMDEXP(ABMMODE(7),0)["UB" D
.I $P(ABMX("X0"),U,2)="" S ABME(121)=""
I (^ABMDEXP(ABMMODE(7),0)["HCFA")!(^ABMDEXP(ABMMODE(7),0)["CMS") D
.I $P(ABMX("X0"),"^",10)="" S ABME(122)=""
.S ABMCODXS=$P(ABMX("X0"),U,10)
.I ABMCODXS'="" D
..F ABMJ=1:1 S ABMCODX=$P(ABMCODXS,",",ABMJ) Q:+$G(ABMCODX)=0 D
...;start new abm*2.6*8 NOHEAT
...;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") Q:ABME(217)[(ABMX("I")) S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))="") S ABME(217)=ABMX("I")
...;end new
I $P(ABMX("X0"),U,3)="" S ABME(132)=""
I $P(ABMX("X0"),U,4)="" S ABME(126)=""
I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U)))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,2)),U,2)="") D ;abm*2.6*9 NARR
.Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010" ;abm*2.6*9 NARR
.K ABMP("CPTNT") S ABMP("CPTNT")=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U),0)) ;abm*2.6*9 NARR
.Q:($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y") ;abm*2.6*9 NARR
.S ABME(241)=$S('$D(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I")) ;abm*2.6*9 NARR
I ABMMODE(7) D
.S ABMPIEN=0
.F S ABMPIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,"P",ABMPIEN)) Q:+ABMPIEN=0 D
..S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,"P",ABMPIEN,0)),U)
..;start new abm*2.6*8 NOHEAT
..I ABMNPIUS="N",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(220)=$S('$D(ABME(220)):ABMX("I"),1:ABME(220)_","_ABMX("I"))
..I ABMNPIUS="B",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(221)=$S('$D(ABME(221)):ABMX("I"),1:ABME(221)_","_ABMX("I"))
..;end new
..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,"P",ABMPIEN,0)),U,2)'="D"
..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,"P",ABMPIEN,0)),U)
..I $P($G(^VA(200,ABMPRV,.11)),U)="" S ABME(216)=ABMX ;provider street
..I $P($G(^VA(200,ABMPRV,.11)),U,4)="" S ABME(216)=ABMX ;city
..I $P($G(^VA(200,ABMPRV,.11)),U,5)="" S ABME(216)=ABMX ;state
..I $P($G(^VA(200,ABMPRV,.11)),U,6)="" S ABME(216)=ABMX ;zip
K ABMPIEN
Q
;
H1 ;EP - Entry Point Page 8H error checks cont
S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,0)
I ^ABMDEXP(ABMMODE(8),0)["UB" D
.I $P(ABMX("X0"),U,2)="" S ABME(121)=""
I (^ABMDEXP(ABMMODE(8),0)["HCFA")!(^ABMDEXP(ABMMODE(8),0)["CMS") D
.I $P(ABMX("X0"),"^",6)="" S ABME(122)=""
.S ABMCODXS=$P(ABMX("X0"),U,6)
.I ABMCODXS'="" D
..F ABMJ=1:1 S ABMCODX=$P(ABMCODXS,",",ABMJ) Q:+$G(ABMCODX)=0 D
...;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") Q:ABME(217)[(ABMX("I")) S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))="") S ABME(217)=ABMX("I")
I $P(ABMX("X0"),U,3)="" S ABME(123)=""
I $P(ABMX("X0"),U,4)="" S ABME(126)=""
I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U)))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,2)),U,2)="") D ;abm*2.6*9 NARR
.Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010" ;abm*2.6*9 NARR
.K ABMP("CPTNT") S ABMP("CPTNT")=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U),0)) ;abm*2.6*9 NARR
.Q:($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y") ;abm*2.6*9 NARR
.S ABME(241)=$S('$D(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I")) ;abm*2.6*9 NARR
I $P($G(^DIC(40.7,ABMP("CLN"),0)),U,2)["A3" D
.S ABMCIEN=0
.F S ABMCIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,"B",ABMCIEN)) Q:ABMCIEN="" D
..I $P($$CPT^ABMCVAPI(ABMCIEN,ABMP("VDT")),U,2)="J3490",($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),10)),U)="") S ABME(210)="" ;CSV-c
..S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,"B",ABMCIEN,0))
..I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMIEN,0)),U,5)="QL" S ABME(212)=""
..I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMIEN,0)),U,8)="QL" S ABME(212)=""
..I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMIEN,0)),U,9)="QL" S ABME(212)=""
I ABMMODE(8)=22!(ABMMODE(8)=27) D
.S ABMPIEN=0
.F S ABMPIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,"P",ABMPIEN)) Q:+ABMPIEN=0 D
..S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,"P",ABMPIEN,0)),U)
..;start new abm*2.6*8 NOHEAT
..I ABMNPIUS="N",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(220)=$S('$D(ABME(220)):ABMX("I"),1:ABME(220)_","_ABMX("I"))
..I ABMNPIUS="B",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(221)=$S('$D(ABME(221)):ABMX("I"),1:ABME(221)_","_ABMX("I"))
..;end new
..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,"P",ABMPIEN,0)),U,2)'="D"
..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,"P",ABMPIEN,0)),U)
..I $P($G(^VA(200,ABMPRV,.11)),U)="" S ABME(216)=ABMX ;provider street
..I $P($G(^VA(200,ABMPRV,.11)),U,4)="" S ABME(216)=ABMX ;city
..I $P($G(^VA(200,ABMPRV,.11)),U,5)="" S ABME(216)=ABMX ;state
..I $P($G(^VA(200,ABMPRV,.11)),U,6)="" S ABME(216)=ABMX ;zip
K ABMPIEN
Q
K1 ;EP - Entry Point Page 8K error checks cont
S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMX,0)
I ^ABMDEXP(ABMMODE(8),0)["UB" D
.I $P(ABMX("X0"),U,2)="" S ABME(121)=""
I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U)))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMX,2)),U,2)="") D ;abm*2.6*9 NARR
.Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010" ;abm*2.6*9 NARR
.K ABMP("CPTNT") S ABMP("CPTNT")=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U),0)) ;abm*2.6*9 NARR
.Q:($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y") ;abm*2.6*9 NARR
.S ABME(241)=$S('$D(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I")) ;abm*2.6*9 NARR
I (^ABMDEXP(ABMMODE(8),0)["HCFA")!(^ABMDEXP(ABMMODE(8),0)["CMS") D
.I $P(ABMX("X0"),"^",6)="" S ABME(122)=""
.S ABMCODXS=$P(ABMX("X0"),U,6)
.I ABMCODXS'="" D
..F ABMJ=1:1 S ABMCODX=$P(ABMCODXS,",",ABMJ) Q:+$G(ABMCODX)=0 D
...;start new abm*2.6*8 NOHEAT
...;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") Q:ABME(217)[(ABMX("I")) S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))="") S ABME(217)=ABMX("I")
...;end new
I $P(ABMX("X0"),U,3)="" S ABME(123)=""
I $P(ABMX("X0"),U,4)="" S ABME(126)=""
I $P(ABMX("X0"),U,5)="" D
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,14)="",($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,16)="") S ABME(209)=""
I $P($G(^DIC(40.7,ABMP("CLN"),0)),U,2)["A3" D
.S ABMIEN=0
.F S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMIEN)) Q:ABMIEN="" D
..I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMIEN,0)),U,5)="QL" S ABME(212)=""
..I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMIEN,0)),U,8)="QL" S ABME(212)=""
..I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMIEN,0)),U,9)="QL" S ABME(212)=""
Q
ABMDE8X1 ; IHS/ASDST/DMJ - Page 8 - ERROR CHECKS-CONT ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**8,9,13,14,21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR- v2.5 p8 task 6 - Added code for page 8K error checks; also added to page 8H error checks for ambulance billing
+3 ;IHS/SD/SDR- v2.5 p9 task 1 - Added code to check for provider address
+4 ;IHS/SD/SDR- v2.5 p10 IM20394 - Added code for new error 217
+5 ;IHS/SD/SDR- v2.5 p11 NPI - Added code for NPI errors 220 and 221
+6 ;
+7 ;IHS/SD/SDR- v2.6 CSV
+8 ;IHS/SD/SDR- 2.6*13 Added check for new export mode 35
+9 ;IHS/SD/SDR- 2.6*14 ICD10 008 - Added warning if service lines cross over ICD10 EFFECTIVE DATE
+10 ;IHS/SD/SDR- 2.6*14 HEAT163747 - Updated error 217 so it only displays one for ea service line, no matter how many coor dx are present
+11 ;IHS/SD/SDR- 2.6*21 HEAT135540 - Added error 200 so it will display if there is a 90 modifier but
+12 ; the referring CLIA is blank.
+13 ;
E1 ;EP - Entry Point Page 8E error checks cont
+1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)
+2 ;start new abm*2.6*14 ICD10 008
+3 SET ABMP("SLFDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)),U,5)
+4 SET ABMP("SLTDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)),U,12)
+5 IF (ABMP("ICD10")>ABMP("SLFDT"))&(ABMP("ICD10")<ABMP("SLTDT"))
SET ABME(249)=$SELECT($GET(ABME(249))="":ABMX,1:$GET(ABME(249))_","_ABMX)
+6 ;end new ICD10 008
+7 IF ^ABMDEXP(ABMMODE(5),0)["UB"
Begin DoDot:1
+8 IF $PIECE(ABMX("X0"),U,2)=""
SET ABME(121)=""
End DoDot:1
+9 IF (^ABMDEXP(ABMMODE(5),0)["HCFA")!(^ABMDEXP(ABMMODE(5),0)["CMS")
Begin DoDot:1
+10 IF $PIECE(ABMX("X0"),"^",9)=""
SET ABME(122)=""
+11 ;start new abm*2.6*21 IHS/SD/SDR HEAT135540
+12 IF $PIECE(ABMX("X0"),U,6,8)["90"
IF $PIECE(ABMX("X0"),U,14)=""
Begin DoDot:2
+13 IF $GET(ABME(200))'=""
SET ABME(200)=$GET(ABME(200))_","_ABMX("I")
+14 IF $GET(ABME(200))=""
SET ABME(200)=ABMX("I")
End DoDot:2
+15 ;end new abm*2.6*21 IHS/SD/SDR HEAT135540
+16 SET ABMCODXS=$PIECE(ABMX("X0"),U,9)
+17 IF ABMCODXS'=""
Begin DoDot:2
+18 FOR ABMJ=1:1
SET ABMCODX=$PIECE(ABMCODXS,",",ABMJ)
IF +$GET(ABMCODX)=0
QUIT
Begin DoDot:3
+19 ;start new abm*2.6*8 NOHEAT
+20 ;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
+21 ;abm*2.6*14 HEAT163747
IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))'="")
IF ABME(217)[(ABMX("I"))
QUIT
SET ABME(217)=$GET(ABME(217))_","_ABMX("I")
+22 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))="")
SET ABME(217)=ABMX("I")
+23 ;end new
End DoDot:3
End DoDot:2
End DoDot:1
+24 IF $PIECE(ABMX("X0"),U,3)=""
SET ABME(123)=""
+25 IF $PIECE(ABMX("X0"),U,4)=""
SET ABME(126)=""
+26 IF +$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",$PIECE(ABMX("X0"),U),0))'=0
Begin DoDot:1
+27 ;837P only
IF ABMMODE(5)'=22
QUIT
+28 IF '$DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",$PIECE(ABMX("X0"),U)))
QUIT
+29 SET ABMIIEN=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",$PIECE(ABMX("X0"),U),0))
+30 ;quit if not required
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,ABMIIEN,0)),U,2)'="Y"
QUIT
+31 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)),U,19)=""
SET ABME(233)=""
+32 ;lab result req'd
IF +$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,0)),U,21)=0
SET ABME(233)=""
End DoDot:1
+33 ;abm*2.6*9 NARR
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U)))&($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,2)),U,2)="")
Begin DoDot:1
+34 ;abm*2.6*9 NARR
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
QUIT
+35 ;abm*2.6*9 NARR
KILL ABMP("CPTNT")
SET ABMP("CPTNT")=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U),0))
+36 ;abm*2.6*9 NARR
IF ($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y")
QUIT
+37 ;abm*2.6*9 NARR
SET ABME(241)=$SELECT('$DATA(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))
End DoDot:1
+38 ;I ABMMODE(5)=22!(ABMMODE(5)=27) D ;abm*2.6*13 export mode 35
+39 ;abm*2.6*13 export mode 35
IF ABMMODE(5)=22!(ABMMODE(5)=27)!(ABMMODE(5)=35)
Begin DoDot:1
+40 SET ABMPIEN=0
+41 FOR
SET ABMPIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,"P",ABMPIEN))
IF +ABMPIEN=0
QUIT
Begin DoDot:2
+42 SET ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+43 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,"P",ABMPIEN,0)),U)
+44 ;start new abm*2.6*8 NOHEAT
+45 IF ABMNPIUS="N"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0)
SET ABME(220)=$SELECT('$DATA(ABME(220)):ABMX("I"),1:ABME(220)_","_ABMX("I"))
+46 IF ABMNPIUS="B"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0)
SET ABME(221)=$SELECT('$DATA(ABME(221)):ABMX("I"),1:ABME(221)_","_ABMX("I"))
+47 ;end new
+48 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,"P",ABMPIEN,0)),U,2)'="D"
QUIT
+49 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX,"P",ABMPIEN,0)),U)
+50 ;provider street
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U)=""
SET ABME(216)=ABMX
+51 ;city
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,4)=""
SET ABME(216)=ABMX
+52 ;state
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,5)=""
SET ABME(216)=ABMX
+53 ;zip
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,6)=""
SET ABME(216)=ABMX
End DoDot:2
End DoDot:1
+54 KILL ABMPIEN
+55 QUIT
+56 ;
F1 ;EP - Entry Point Page 8F error checks cont
+1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,0)
+2 ;start new abm*2.6*14 ICD10 008
+3 SET ABMP("SLFDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,0)),U,9)
+4 SET ABMP("SLTDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,0)),U,12)
+5 IF (ABMP("ICD10")>ABMP("SLFDT"))&(ABMP("ICD10")<ABMP("SLTDT"))
SET ABME(249)=$SELECT($GET(ABME(249))="":ABMX,1:$GET(ABME(249))_","_ABMX)
+6 ;end new ICD10 008
+7 IF ^ABMDEXP(ABMMODE(6),0)["UB"
Begin DoDot:1
+8 IF $PIECE(ABMX("X0"),U,2)=""
SET ABME(121)=""
End DoDot:1
+9 IF (^ABMDEXP(ABMMODE(6),0)["HCFA")!(^ABMDEXP(ABMMODE(6),0)["CMS")
Begin DoDot:1
+10 IF $PIECE(ABMX("X0"),"^",8)=""
SET ABME(122)=""
+11 SET ABMCODXS=$PIECE(ABMX("X0"),U,8)
+12 IF ABMCODXS'=""
Begin DoDot:2
+13 FOR ABMJ=1:1
SET ABMCODX=$PIECE(ABMCODXS,",",ABMJ)
IF +$GET(ABMCODX)=0
QUIT
Begin DoDot:3
+14 ;start new abm*2.6*8 NOHEAT
+15 ;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
+16 ;abm*2.6*14 HEAT163747
IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))'="")
IF ABME(217)[(ABMX("I"))
QUIT
SET ABME(217)=$GET(ABME(217))_","_ABMX("I")
+17 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))="")
SET ABME(217)=ABMX("I")
+18 ;end new
End DoDot:3
End DoDot:2
End DoDot:1
+19 IF $PIECE(ABMX("X0"),U,3)=""
SET ABME(123)=""
+20 IF $PIECE(ABMX("X0"),U,4)=""
SET ABME(126)=""
+21 ;abm*2.6*9 NARR
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U)))&($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,2)),U,2)="")
Begin DoDot:1
+22 ;abm*2.6*9 NARR
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
QUIT
+23 ;abm*2.6*9 NARR
KILL ABMP("CPTNT")
SET ABMP("CPTNT")=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U),0))
+24 ;abm*2.6*9 NARR
IF ($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y")
QUIT
+25 ;abm*2.6*9 NARR
SET ABME(241)=$SELECT('$DATA(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))
End DoDot:1
+26 ;I ABMMODE(6)=22!(ABMMODE(6)=27) D ;abm*2.6*13 export mode 35
+27 ;abm*2.6*13 export mode 35
IF ABMMODE(6)=22!(ABMMODE(6)=27)!(ABMMODE(6)=35)
Begin DoDot:1
+28 SET ABMPIEN=0
+29 FOR
SET ABMPIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,"P",ABMPIEN))
IF +ABMPIEN=0
QUIT
Begin DoDot:2
+30 SET ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+31 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,"P",ABMPIEN,0)),U)
+32 ;start new abm*2.6*8 NOHEAT
+33 IF ABMNPIUS="N"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0)
SET ABME(220)=$SELECT('$DATA(ABME(220)):ABMX("I"),1:ABME(220)_","_ABMX("I"))
+34 IF ABMNPIUS="B"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0)
SET ABME(221)=$SELECT('$DATA(ABME(221)):ABMX("I"),1:ABME(221)_","_ABMX("I"))
+35 ;end new
+36 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,"P",ABMPIEN,0)),U,2)'="D"
QUIT
+37 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX,"P",ABMPIEN,0)),U)
+38 ;provider street
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U)=""
SET ABME(216)=ABMX
+39 ;city
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,4)=""
SET ABME(216)=ABMX
+40 ;state
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,5)=""
SET ABME(216)=ABMX
+41 ;zip
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,6)=""
SET ABME(216)=ABMX
End DoDot:2
End DoDot:1
+42 KILL ABMPIEN
+43 QUIT
+44 ;
G1 ;EP - Entry Point Page 8G error checks cont
+1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,0)
+2 IF ^ABMDEXP(ABMMODE(7),0)["UB"
Begin DoDot:1
+3 IF $PIECE(ABMX("X0"),U,2)=""
SET ABME(121)=""
End DoDot:1
+4 IF (^ABMDEXP(ABMMODE(7),0)["HCFA")!(^ABMDEXP(ABMMODE(7),0)["CMS")
Begin DoDot:1
+5 IF $PIECE(ABMX("X0"),"^",10)=""
SET ABME(122)=""
+6 SET ABMCODXS=$PIECE(ABMX("X0"),U,10)
+7 IF ABMCODXS'=""
Begin DoDot:2
+8 FOR ABMJ=1:1
SET ABMCODX=$PIECE(ABMCODXS,",",ABMJ)
IF +$GET(ABMCODX)=0
QUIT
Begin DoDot:3
+9 ;start new abm*2.6*8 NOHEAT
+10 ;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
+11 ;abm*2.6*14 HEAT163747
IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))'="")
IF ABME(217)[(ABMX("I"))
QUIT
SET ABME(217)=$GET(ABME(217))_","_ABMX("I")
+12 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))="")
SET ABME(217)=ABMX("I")
+13 ;end new
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF $PIECE(ABMX("X0"),U,3)=""
SET ABME(132)=""
+15 IF $PIECE(ABMX("X0"),U,4)=""
SET ABME(126)=""
+16 ;abm*2.6*9 NARR
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U)))&($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,2)),U,2)="")
Begin DoDot:1
+17 ;abm*2.6*9 NARR
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
QUIT
+18 ;abm*2.6*9 NARR
KILL ABMP("CPTNT")
SET ABMP("CPTNT")=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U),0))
+19 ;abm*2.6*9 NARR
IF ($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y")
QUIT
+20 ;abm*2.6*9 NARR
SET ABME(241)=$SELECT('$DATA(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))
End DoDot:1
+21 IF ABMMODE(7)
Begin DoDot:1
+22 SET ABMPIEN=0
+23 FOR
SET ABMPIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,"P",ABMPIEN))
IF +ABMPIEN=0
QUIT
Begin DoDot:2
+24 SET ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+25 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,"P",ABMPIEN,0)),U)
+26 ;start new abm*2.6*8 NOHEAT
+27 IF ABMNPIUS="N"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0)
SET ABME(220)=$SELECT('$DATA(ABME(220)):ABMX("I"),1:ABME(220)_","_ABMX("I"))
+28 IF ABMNPIUS="B"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0)
SET ABME(221)=$SELECT('$DATA(ABME(221)):ABMX("I"),1:ABME(221)_","_ABMX("I"))
+29 ;end new
+30 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,"P",ABMPIEN,0)),U,2)'="D"
QUIT
+31 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX,"P",ABMPIEN,0)),U)
+32 ;provider street
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U)=""
SET ABME(216)=ABMX
+33 ;city
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,4)=""
SET ABME(216)=ABMX
+34 ;state
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,5)=""
SET ABME(216)=ABMX
+35 ;zip
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,6)=""
SET ABME(216)=ABMX
End DoDot:2
End DoDot:1
+36 KILL ABMPIEN
+37 QUIT
+38 ;
H1 ;EP - Entry Point Page 8H error checks cont
+1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,0)
+2 IF ^ABMDEXP(ABMMODE(8),0)["UB"
Begin DoDot:1
+3 IF $PIECE(ABMX("X0"),U,2)=""
SET ABME(121)=""
End DoDot:1
+4 IF (^ABMDEXP(ABMMODE(8),0)["HCFA")!(^ABMDEXP(ABMMODE(8),0)["CMS")
Begin DoDot:1
+5 IF $PIECE(ABMX("X0"),"^",6)=""
SET ABME(122)=""
+6 SET ABMCODXS=$PIECE(ABMX("X0"),U,6)
+7 IF ABMCODXS'=""
Begin DoDot:2
+8 FOR ABMJ=1:1
SET ABMCODX=$PIECE(ABMCODXS,",",ABMJ)
IF +$GET(ABMCODX)=0
QUIT
Begin DoDot:3
+9 ;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
+10 ;abm*2.6*14 HEAT163747
IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))'="")
IF ABME(217)[(ABMX("I"))
QUIT
SET ABME(217)=$GET(ABME(217))_","_ABMX("I")
+11 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))="")
SET ABME(217)=ABMX("I")
End DoDot:3
End DoDot:2
End DoDot:1
+12 IF $PIECE(ABMX("X0"),U,3)=""
SET ABME(123)=""
+13 IF $PIECE(ABMX("X0"),U,4)=""
SET ABME(126)=""
+14 ;abm*2.6*9 NARR
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U)))&($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,2)),U,2)="")
Begin DoDot:1
+15 ;abm*2.6*9 NARR
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
QUIT
+16 ;abm*2.6*9 NARR
KILL ABMP("CPTNT")
SET ABMP("CPTNT")=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U),0))
+17 ;abm*2.6*9 NARR
IF ($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y")
QUIT
+18 ;abm*2.6*9 NARR
SET ABME(241)=$SELECT('$DATA(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))
End DoDot:1
+19 IF $PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U,2)["A3"
Begin DoDot:1
+20 SET ABMCIEN=0
+21 FOR
SET ABMCIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,"B",ABMCIEN))
IF ABMCIEN=""
QUIT
Begin DoDot:2
+22 ;CSV-c
IF $PIECE($$CPT^ABMCVAPI(ABMCIEN,ABMP("VDT")),U,2)="J3490"
IF ($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),10)),U)="")
SET ABME(210)=""
+23 SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,"B",ABMCIEN,0))
+24 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMIEN,0)),U,5)="QL"
SET ABME(212)=""
+25 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMIEN,0)),U,8)="QL"
SET ABME(212)=""
+26 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMIEN,0)),U,9)="QL"
SET ABME(212)=""
End DoDot:2
End DoDot:1
+27 IF ABMMODE(8)=22!(ABMMODE(8)=27)
Begin DoDot:1
+28 SET ABMPIEN=0
+29 FOR
SET ABMPIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,"P",ABMPIEN))
IF +ABMPIEN=0
QUIT
Begin DoDot:2
+30 SET ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+31 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,"P",ABMPIEN,0)),U)
+32 ;start new abm*2.6*8 NOHEAT
+33 IF ABMNPIUS="N"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0)
SET ABME(220)=$SELECT('$DATA(ABME(220)):ABMX("I"),1:ABME(220)_","_ABMX("I"))
+34 IF ABMNPIUS="B"
IF ($PIECE($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0)
SET ABME(221)=$SELECT('$DATA(ABME(221)):ABMX("I"),1:ABME(221)_","_ABMX("I"))
+35 ;end new
+36 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,"P",ABMPIEN,0)),U,2)'="D"
QUIT
+37 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX,"P",ABMPIEN,0)),U)
+38 ;provider street
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U)=""
SET ABME(216)=ABMX
+39 ;city
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,4)=""
SET ABME(216)=ABMX
+40 ;state
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,5)=""
SET ABME(216)=ABMX
+41 ;zip
IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,6)=""
SET ABME(216)=ABMX
End DoDot:2
End DoDot:1
+42 KILL ABMPIEN
+43 QUIT
K1 ;EP - Entry Point Page 8K error checks cont
+1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMX,0)
+2 IF ^ABMDEXP(ABMMODE(8),0)["UB"
Begin DoDot:1
+3 IF $PIECE(ABMX("X0"),U,2)=""
SET ABME(121)=""
End DoDot:1
+4 ;abm*2.6*9 NARR
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U)))&($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMX,2)),U,2)="")
Begin DoDot:1
+5 ;abm*2.6*9 NARR
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
QUIT
+6 ;abm*2.6*9 NARR
KILL ABMP("CPTNT")
SET ABMP("CPTNT")=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U),0))
+7 ;abm*2.6*9 NARR
IF ($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y")
QUIT
+8 ;abm*2.6*9 NARR
SET ABME(241)=$SELECT('$DATA(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))
End DoDot:1
+9 IF (^ABMDEXP(ABMMODE(8),0)["HCFA")!(^ABMDEXP(ABMMODE(8),0)["CMS")
Begin DoDot:1
+10 IF $PIECE(ABMX("X0"),"^",6)=""
SET ABME(122)=""
+11 SET ABMCODXS=$PIECE(ABMX("X0"),U,6)
+12 IF ABMCODXS'=""
Begin DoDot:2
+13 FOR ABMJ=1:1
SET ABMCODX=$PIECE(ABMCODXS,",",ABMJ)
IF +$GET(ABMCODX)=0
QUIT
Begin DoDot:3
+14 ;start new abm*2.6*8 NOHEAT
+15 ;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I") ;abm*2.6*14 HEAT163747
+16 ;abm*2.6*14 HEAT163747
IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))'="")
IF ABME(217)[(ABMX("I"))
QUIT
SET ABME(217)=$GET(ABME(217))_","_ABMX("I")
+17 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))="")
SET ABME(217)=ABMX("I")
+18 ;end new
End DoDot:3
End DoDot:2
End DoDot:1
+19 IF $PIECE(ABMX("X0"),U,3)=""
SET ABME(123)=""
+20 IF $PIECE(ABMX("X0"),U,4)=""
SET ABME(126)=""
+21 IF $PIECE(ABMX("X0"),U,5)=""
Begin DoDot:1
+22 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,14)=""
IF ($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,16)="")
SET ABME(209)=""
End DoDot:1
+23 IF $PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U,2)["A3"
Begin DoDot:1
+24 SET ABMIEN=0
+25 FOR
SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMIEN))
IF ABMIEN=""
QUIT
Begin DoDot:2
+26 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMIEN,0)),U,5)="QL"
SET ABME(212)=""
+27 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMIEN,0)),U,8)="QL"
SET ABME(212)=""
+28 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMIEN,0)),U,9)="QL"
SET ABME(212)=""
End DoDot:2
End DoDot:1
+29 QUIT
