ABMDE8X.m

ABMDE8X ; IHS/ASDST/DMJ - Page 8 - ERROR CHECKS ; 

 ;;2.6;IHS Third Party Billing System;**3,6,8,9,13,14,19**;NOV 12, 2009;Build 300

 ;IHS/SD/SDR - v2.6 CSV

 ;IHS/SD/SDR -2.6*3- HEAT12234 - Require coor. DX for all CPT categories

 ;IHS/SD/SDR -2.6*6- 5010 - error 239 if no RX number on line

 ;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*19 - HEAT173117 - Added code for error 241 on page 8D for missing CPT Narrative

 ;

A ;EP - Entry Point for Page 8A Errors

 D MODE

 S ABMX=0 F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX)) Q:'ABMX  D A1  ;abm*2.6*8

 S ABME("TITL")="PAGE 8A - MEDICAL SERVICES"

 I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,1)="Y" S ABME(163)=""

 G XIT

A1 ;A1

 S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,0)

 S ABMX("CPT")=$P(ABMX("X0"),U)

 K:$P($$CPT^ABMCVAPI(ABMX("CPT"),ABMP("VDT")),U,4)=28 ABME(182)  ;CSV-c

 ;start new abm*2.6*14 ICD10 008

 S ABMP("SLFDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,0)),U,7)

 S ABMP("SLTDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,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(1),0)["UB" D

 .I $P(ABMX("X0"),U,2)="" S ABME(121)=""

 I $P(ABMX("X0"),U,3)="" S ABME(123)=""

 I $P(ABMX("X0"),U,4)="" S ABME(126)=""

 I (^ABMDEXP(ABMMODE(1),0)["HCFA")!(^ABMDEXP(ABMMODE(1),0)["CMS") D

 .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,6)="" S ABME(122)=$S($D(ABME(122)):ABME(122)_","_ABMX("I"),1:ABMX("I")) Q

 I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMX("CPT")))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,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",ABMX("CPT"),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(1)=22!(ABMMODE(1)=27) D

 .S ABMPIEN=0

 .F  S ABMPIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,"P",ABMPIEN)) Q:+ABMPIEN=0  D

 ..S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))

 ..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,"P",ABMPIEN,0)),U)

 ..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"))

 ..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,"P",ABMPIEN,0)),U,2)'="D"

 ..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,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

 ;

B ;EP - Entry Point for Page 8B Errors

 D MODE

 ;start new abm*2.6*14 ICD10 008

 S ABMX=0

 F  S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX)) Q:'ABMX  D

 .S ABMP("SLFDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,0)),U,5)

 .S ABMP("SLTDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,0)),U,19)

 .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

 S ABMX="" F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABMX)) Q:ABMX=""  S ABMX(1)=$O(^(ABMX,"")) D B1

 I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,1)="Y" S ABME(163)=""

 S ABME("TITL")="PAGE 8B - SURGICAL PROCEDURES"

 I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O")),('$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,0)))&('$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0))) S ABME(1)=""  ;abm*2.6*8 HEAT42572

 G XIT

B1 ;

 D B1^ABMDE8X2  ;abm*2.6*19 IHS/SD/SDR HEAT173117 - split to routine ABMDE8X2

 Q

 ;

C ;EP - Entry Point for Page 8C Errors

 Q:$D(^ABMDPARM(DUZ(2),1,11,2))

 Q:ABMP("VTYP")'=111

 S ABMX=0,ABMX("CNT")=0 F  S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,ABMX)) Q:'ABMX  D C1

 S ABMX("DAYS")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,3) S:ABMX("DAYS")<1 ABMX("DAYS")=1

 I ABMX("DAYS")<ABMX("CNT") S ABME(142)=""

 S ABME("TITL")="PAGE 8C - REVENUE CODE"

 G XIT

C1 S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),25,ABMX,0)

 I +ABMX("X0")>99&(+ABMX("X0")<220) S ABMX("CNT")=ABMX("CNT")+$P(ABMX("X0"),U,2)

 I $P(ABMX("X0"),U,2)="" S ABME(123)=""

 I $P(ABMX("X0"),U,3)="" S ABME(126)=""

 I +$P(ABMX("X0"),U,7),$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U,7)))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,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,7),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,1:ABME(241)_","_ABMX)  ;abm*2.6*9 NARR

 Q

 ;

D ;EP - Entry Point for Page 8D Errors

 Q:$D(^ABMDPARM(DUZ(2),1,11,6))

 D MODE

 I $P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,997,0)),U,4),$D(^ABMDERR(175,21,$P(^(0),U,4),0)) S ABMZ("RX")=""

 S ABMX=0 F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX)) Q:'ABMX  D D1

 D D2

 S ABME("TITL")="PAGE 8D - MEDICATIONS"

 G XIT

D1 S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX,0)

 ;start new abm*2.6*14 ICD10 008

 S ABMP("SLFDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX,0)),U,14)

 S ABMP("SLTDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX,0)),U,28)

 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(4),0)["UB" D

 .I $P(ABMX("X0"),U,2)="" S ABME(121)=""

 I (^ABMDEXP(ABMMODE(4),0)["HCFA")!(^ABMDEXP(ABMMODE(4),0)["CMS") D

 .I $P(ABMX("X0"),"^",13)="" S ABME(188)=""

 .S ABMCODXS=$P(ABMX("X0"),U,13)

 .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 (ABMMODE(4)=31!(ABMMODE(4)=32))&($P(ABMX("X0"),U,6)="")&($P(ABMX("X0"),U,22)="") S ABME(239)=$S($G(ABME(239)):$G(ABME(239))_","_ABMX("I"),1:ABMX("I"))  ;abm*2.6*8 5010

 I $P(ABMX("X0"),U,3)="" S ABME(123)=""

 I $P(ABMX("X0"),U,4)="" S ABME(165)=""

 I $P(ABMX("X0"),U,5)="",ABMP("BTYP")'=111 S ABME(135)=""

 I $D(ABMZ("RX")),'$P(ABMX("X0"),U,6) S ABME(175)=$S($D(ABME(175)):ABME(175)_",",1:"")_ABMX("I")

 ;I ABMMODE(4)=22!(ABMMODE(4)=27) D  ;abm*2.6*13 export mode 35

 I ABMMODE(4)=22!(ABMMODE(4)=27)!(ABMMODE(4)=35) D  ;abm*2.6*13 export mode 35

 .S ABMPIEN=0

 .F  S ABMPIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,"P",ABMPIEN)) Q:+ABMPIEN=0  D

 ..S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))

 ..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,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"),21,ABMX,"P",ABMPIEN,0)),U,2)'="D"

 ..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,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

 ;start new abm*2.6*19 IHS/SD/SDR HEAT173117

 I (+$P($G(ABMX("X0")),U,29)'=0) D

 .I ($D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U,29))))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX,3)),U,2)="") D

 ..Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"

 ..K ABMP("CPTNT") S ABMP("CPTNT")=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P(ABMX("X0"),U,29),0))

 ..Q:($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y")

 ..S ABME(241)=$S('$D(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))

 ;end new abm*2.6*19 IHS/SD/SDR HEAT173117 

 Q

D2 ;EP - this next section compares entries in V Med vs 23 multiple; will

 D D2^ABMDE8X2  ;split routine abm*2.6*13

 Q

 ;

E ;EP - Entry Point for Page 8E Errors

 Q:$D(^ABMDPARM(DUZ(2),1,11,3))

 D MODE

 S ABMX=0 F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX)) Q:'ABMX  D E1^ABMDE8X1  ;abm*2.6*8

 S ABMX("V")=0 F  S ABMX("V")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMX("V"))) Q:'ABMX("V")  I $D(^AUPNVLAB("AD",ABMX("V"))) S ABME(174)="" Q

 S ABME("TITL")="PAGE 8E - LABORATORY PROCEDURES"

 G XIT

 ;

F ;EP - Entry Point for Page 8F Errors

 Q:$D(^ABMDPARM(DUZ(2),1,11,4))

 D MODE

 S ABMX=0 F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX)) Q:'ABMX  D F1^ABMDE8X1  ;abm*2.6*8

 S ABME("TITL")="PAGE 8F - RADIOLOGY PROCEDURES"

 G XIT

 ;

G ;EP - Entry Point for Page 8G Errors

 Q:$D(^ABMDPARM(DUZ(2),1,11,5))

 D MODE

 S ABMX=0 F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX)) Q:'ABMX  D G1^ABMDE8X1  ;abm*2.6*8

 S ABME("TITL")="PAGE 8G - ANESTHESIA PROCEDURES"

 G XIT

 ;

H ;EP - Entry Point for Page 8H Errors

 Q:$D(^ABMDPARM(DUZ(2),1,11,8))

 D MODE

 S ABMX=0 F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX)) Q:'ABMX  D H1^ABMDE8X1  ;abm*2.6*8

 S ABME("TITL")="PAGE 8H - MISC. SERVICES"

 G XIT

 ;

J ;EP - Entry Point for Page 8J Errors

 Q:$D(^ABMDPARM(DUZ(2),1,11,9))

 D MODE

 S ABMX=0 F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX)) Q:'ABMX  D  ;abm*2.6*8

 .S ABMX("CPT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,0)),U,7)  ;abm*2.6*14 to fix <UNDEF>J+16^ABMDE8X

 .I ^ABMDEXP(ABMMODE(10),0)["UB" D

 ..I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,0),"^",5)="" S ABME(121)=""

 .I (^ABMDEXP(ABMMODE(10),0)["HCFA")!(^ABMDEXP(ABMMODE(10),0)["CMS") D

 ..I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,0),"^",6)="" S ABME(122)=""

 ..S ABMCODXS=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,0)),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 $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMX("CPT")))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,2)),U,2)="") D  ;abm*2.6*9 NARR

 .....Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"  ;abm*2.6*9 NARR

 .....S ABME(241)=$S('$D(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))  ;abm*2.6*9 NARR

 S ABME("TITL")="PAGE 8J - SUPPLIES"

 G XIT

K ;EP - Entry Point for Page 8K Errors

 Q:$D(^ABMDPARM(DUZ(2),1,11,8))

 D MODE

 S ABMX=0 F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMX)) Q:'ABMX  D K1^ABMDE8X1  ;abm*2.6*8

 S ABME("TITL")="PAGE 8K - AMBULANCE SERVICES"

 G XIT

 ;

MODE ;EP - SET MODE OF EXPORT ARRAY

 N I F I=1:1:10 D

 .S ABMMODE(I)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),70)),"^",I)

 .S:ABMMODE(I)="" ABMMODE(I)=ABMP("EXP")

 Q

 ;

XIT ;

 K ABMX,ABMMODE,ABMMEDS

 Q

ABMDE8X   ; IHS/ASDST/DMJ - Page 8 - ERROR CHECKS ; 

 +1       ;;2.6;IHS Third Party Billing System;**3,6,8,9,13,14,19**;NOV 12, 2009;Build 300

 +2       ;IHS/SD/SDR - v2.6 CSV

 +3       ;IHS/SD/SDR -2.6*3- HEAT12234 - Require coor. DX for all CPT categories

 +4       ;IHS/SD/SDR -2.6*6- 5010 - error 239 if no RX number on line

 +5       ;IHS/SD/SDR -2.6*13- Added check for new export mode 35

 +6       ;IHS/SD/SDR -2.6*14- ICD10 008 - Added warning if service lines cross over ICD10 EFFECTIVE DATE

 +7       ;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

 +8       ;IHS/SD/SDR - 2.6*19 - HEAT173117 - Added code for error 241 on page 8D for missing CPT Narrative

 +9       ;

A         ;EP - Entry Point for Page 8A Errors

 +1        DO MODE

 +2       ;abm*2.6*8

           SET ABMX=0

           FOR ABMX("I")=1:1

               SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX))

               IF 'ABMX

                   QUIT 

               DO A1

 +3        SET ABME("TITL")="PAGE 8A - MEDICAL SERVICES"

 +4        IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,1)="Y"

               SET ABME(163)=""

 +5        GOTO XIT

A1        ;A1

 +1        SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,0)

 +2        SET ABMX("CPT")=$PIECE(ABMX("X0"),U)

 +3       ;CSV-c

           IF $PIECE($$CPT^ABMCVAPI(ABMX("CPT"),ABMP("VDT")),U,4)=28

               KILL ABME(182)

 +4       ;start new abm*2.6*14 ICD10 008

 +5        SET ABMP("SLFDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,0)),U,7)

 +6        SET ABMP("SLTDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,0)),U,12)

 +7        IF (ABMP("ICD10")>ABMP("SLFDT"))&(ABMP("ICD10")<ABMP("SLTDT"))

               SET ABME(249)=$SELECT($GET(ABME(249))="":ABMX,1:$GET(ABME(249))_","_ABMX)

 +8       ;end new ICD10 008

 +9        IF ^ABMDEXP(ABMMODE(1),0)["UB"

               Begin DoDot:1

 +10               IF $PIECE(ABMX("X0"),U,2)=""

                       SET ABME(121)=""

               End DoDot:1

 +11       IF $PIECE(ABMX("X0"),U,3)=""

               SET ABME(123)=""

 +12       IF $PIECE(ABMX("X0"),U,4)=""

               SET ABME(126)=""

 +13       IF (^ABMDEXP(ABMMODE(1),0)["HCFA")!(^ABMDEXP(ABMMODE(1),0)["CMS")

               Begin DoDot:1

 +14               SET ABMCODXS=$PIECE(ABMX("X0"),U,6)

 +15               IF ABMCODXS'=""

                       Begin DoDot:2

 +16                       FOR ABMJ=1:1

                               SET ABMCODX=$PIECE(ABMCODXS,",",ABMJ)

                               IF +$GET(ABMCODX)=0

                                   QUIT 

                               Begin DoDot:3

 +17      ;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

 +18      ;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")

 +19                               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

 +20               IF $PIECE(ABMX("X0"),U,6)=""

                       SET ABME(122)=$SELECT($DATA(ABME(122)):ABME(122)_","_ABMX("I"),1:ABMX("I"))

                       QUIT 

               End DoDot:1

 +21      ;abm*2.6*9 NARR

           IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMX("CPT")))&($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,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",ABMX("CPT"),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       IF ABMMODE(1)=22!(ABMMODE(1)=27)

               Begin DoDot:1

 +27               SET ABMPIEN=0

 +28               FOR 

                       SET ABMPIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,"P",ABMPIEN))

                       IF +ABMPIEN=0

                           QUIT 

                       Begin DoDot:2

 +29                       SET ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))

 +30                       SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,"P",ABMPIEN,0)),U)

 +31                       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"))

 +32                       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"))

 +33                       IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,"P",ABMPIEN,0)),U,2)'="D"

                               QUIT 

 +34                       SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABMX,"P",ABMPIEN,0)),U)

 +35      ;provider street

                           IF $PIECE($GET(^VA(200,ABMPRV,.11)),U)=""

                               SET ABME(216)=ABMX

 +36      ;city

                           IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,4)=""

                               SET ABME(216)=ABMX

 +37      ;state

                           IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,5)=""

                               SET ABME(216)=ABMX

 +38      ;zip

                           IF $PIECE($GET(^VA(200,ABMPRV,.11)),U,6)=""

                               SET ABME(216)=ABMX

                       End DoDot:2

               End DoDot:1

 +39       KILL ABMPIEN

 +40       QUIT 

 +41      ;

B         ;EP - Entry Point for Page 8B Errors

 +1        DO MODE

 +2       ;start new abm*2.6*14 ICD10 008

 +3        SET ABMX=0

 +4        FOR 

               SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX))

               IF 'ABMX

                   QUIT 

               Begin DoDot:1

 +5                SET ABMP("SLFDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,0)),U,5)

 +6                SET ABMP("SLTDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,0)),U,19)

 +7                IF (ABMP("ICD10")>ABMP("SLFDT"))&(ABMP("ICD10")<ABMP("SLTDT"))

                       SET ABME(249)=$SELECT($GET(ABME(249))="":ABMX,1:$GET(ABME(249))_","_ABMX)

               End DoDot:1

 +8       ;end new ICD10 008

 +9        SET ABMX=""

           FOR ABMX("I")=1:1

               SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABMX))

               IF ABMX=""

                   QUIT 

               SET ABMX(1)=$ORDER(^(ABMX,""))

               DO B1

 +10       IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),4)),U,1)="Y"

               SET ABME(163)=""

 +11       SET ABME("TITL")="PAGE 8B - SURGICAL PROCEDURES"

 +12      ;abm*2.6*8 HEAT42572

           IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O"))

               IF ('$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,0)))&('$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0)))

                   SET ABME(1)=""

 +13       GOTO XIT

B1        ;

 +1       ;abm*2.6*19 IHS/SD/SDR HEAT173117 - split to routine ABMDE8X2

           DO B1^ABMDE8X2

 +2        QUIT 

 +3       ;

C         ;EP - Entry Point for Page 8C Errors

 +1        IF $DATA(^ABMDPARM(DUZ(2),1,11,2))

               QUIT 

 +2        IF ABMP("VTYP")'=111

               QUIT 

 +3        SET ABMX=0

           SET ABMX("CNT")=0

           FOR 

               SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,ABMX))

               IF 'ABMX

                   QUIT 

               DO C1

 +4        SET ABMX("DAYS")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,3)

           IF ABMX("DAYS")<1

               SET ABMX("DAYS")=1

 +5        IF ABMX("DAYS")<ABMX("CNT")

               SET ABME(142)=""

 +6        SET ABME("TITL")="PAGE 8C - REVENUE CODE"

 +7        GOTO XIT

C1         SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),25,ABMX,0)

 +1        IF +ABMX("X0")>99&(+ABMX("X0")<220)

               SET ABMX("CNT")=ABMX("CNT")+$PIECE(ABMX("X0"),U,2)

 +2        IF $PIECE(ABMX("X0"),U,2)=""

               SET ABME(123)=""

 +3        IF $PIECE(ABMX("X0"),U,3)=""

               SET ABME(126)=""

 +4       ;abm*2.6*9 NARR

           IF +$PIECE(ABMX("X0"),U,7)

               IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U,7)))&($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,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,7),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,1:ABME(241)_","_ABMX)

                   End DoDot:1

 +9        QUIT 

 +10      ;

D         ;EP - Entry Point for Page 8D Errors

 +1        IF $DATA(^ABMDPARM(DUZ(2),1,11,6))

               QUIT 

 +2        DO MODE

 +3        IF $PIECE($GET(^ABMNINS(DUZ(2),+ABMP("INS"),1,997,0)),U,4)

               IF $DATA(^ABMDERR(175,21,$PIECE(^(0),U,4),0))

                   SET ABMZ("RX")=""

 +4        SET ABMX=0

           FOR ABMX("I")=1:1