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
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX))
IF 'ABMX
QUIT
DO D1
+5 DO D2
+6 SET ABME("TITL")="PAGE 8D - MEDICATIONS"
+7 GOTO XIT
D1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX,0)
+1 ;start new abm*2.6*14 ICD10 008
+2 SET ABMP("SLFDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX,0)),U,14)
+3 SET ABMP("SLTDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX,0)),U,28)
+4 IF (ABMP("ICD10")>ABMP("SLFDT"))&(ABMP("ICD10")<ABMP("SLTDT"))
SET ABME(249)=$SELECT($GET(ABME(249))="":ABMX,1:$GET(ABME(249))_","_ABMX)
+5 ;end new ICD10 008
+6 IF ^ABMDEXP(ABMMODE(4),0)["UB"
Begin DoDot:1
+7 IF $PIECE(ABMX("X0"),U,2)=""
SET ABME(121)=""
End DoDot:1
+8 IF (^ABMDEXP(ABMMODE(4),0)["HCFA")!(^ABMDEXP(ABMMODE(4),0)["CMS")
Begin DoDot:1
+9 IF $PIECE(ABMX("X0"),"^",13)=""
SET ABME(188)=""
+10 SET ABMCODXS=$PIECE(ABMX("X0"),U,13)
+11 IF ABMCODXS'=""
Begin DoDot:2
+12 FOR ABMJ=1:1
SET ABMCODX=$PIECE(ABMCODXS,",",ABMJ)
IF +$GET(ABMCODX)=0
QUIT
Begin DoDot:3
+13 ;start new abm*2.6*8 NOHEAT
+14 ;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
+15 ;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")
+16 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))="")
SET ABME(217)=ABMX("I")
+17 ;end new
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;abm*2.6*8 5010
IF (ABMMODE(4)=31!(ABMMODE(4)=32))&($PIECE(ABMX("X0"),U,6)="")&($PIECE(ABMX("X0"),U,22)="")
SET ABME(239)=$SELECT($GET(ABME(239)):$GET(ABME(239))_","_ABMX("I"),1:ABMX("I"))
+19 IF $PIECE(ABMX("X0"),U,3)=""
SET ABME(123)=""
+20 IF $PIECE(ABMX("X0"),U,4)=""
SET ABME(165)=""
+21 IF $PIECE(ABMX("X0"),U,5)=""
IF ABMP("BTYP")'=111
SET ABME(135)=""
+22 IF $DATA(ABMZ("RX"))
IF '$PIECE(ABMX("X0"),U,6)
SET ABME(175)=$SELECT($DATA(ABME(175)):ABME(175)_",",1:"")_ABMX("I")
+23 ;I ABMMODE(4)=22!(ABMMODE(4)=27) D ;abm*2.6*13 export mode 35
+24 ;abm*2.6*13 export mode 35
IF ABMMODE(4)=22!(ABMMODE(4)=27)!(ABMMODE(4)=35)
Begin DoDot:1
+25 SET ABMPIEN=0
+26 FOR
SET ABMPIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,"P",ABMPIEN))
IF +ABMPIEN=0
QUIT
Begin DoDot:2
+27 SET ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
+28 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,"P",ABMPIEN,0)),U)
+29 ;start new abm*2.6*8 NOHEAT
+30 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"))
+31 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"))
+32 ;end new
+33 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,"P",ABMPIEN,0)),U,2)'="D"
QUIT
+34 SET ABMPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,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 ;start new abm*2.6*19 IHS/SD/SDR HEAT173117
+41 IF (+$PIECE($GET(ABMX("X0")),U,29)'=0)
Begin DoDot:1
+42 IF ($DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U,29))))&($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMX,3)),U,2)="")
Begin DoDot:2
+43 IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
QUIT
+44 KILL ABMP("CPTNT")
SET ABMP("CPTNT")=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$PIECE(ABMX("X0"),U,29),0))
+45 IF ($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y")
QUIT
+46 SET ABME(241)=$SELECT('$DATA(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))
End DoDot:2
End DoDot:1
+47 ;end new abm*2.6*19 IHS/SD/SDR HEAT173117
+48 QUIT
D2 ;EP - this next section compares entries in V Med vs 23 multiple; will
+1 ;split routine abm*2.6*13
DO D2^ABMDE8X2
+2 QUIT
+3 ;
E ;EP - Entry Point for Page 8E Errors
+1 IF $DATA(^ABMDPARM(DUZ(2),1,11,3))
QUIT
+2 DO MODE
+3 ;abm*2.6*8
SET ABMX=0
FOR ABMX("I")=1:1
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABMX))
IF 'ABMX
QUIT
DO E1^ABMDE8X1
+4 SET ABMX("V")=0
FOR
SET ABMX("V")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMX("V")))
IF 'ABMX("V")
QUIT
IF $DATA(^AUPNVLAB("AD",ABMX("V")))
SET ABME(174)=""
QUIT
+5 SET ABME("TITL")="PAGE 8E - LABORATORY PROCEDURES"
+6 GOTO XIT
+7 ;
F ;EP - Entry Point for Page 8F Errors
+1 IF $DATA(^ABMDPARM(DUZ(2),1,11,4))
QUIT
+2 DO MODE
+3 ;abm*2.6*8
SET ABMX=0
FOR ABMX("I")=1:1
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABMX))
IF 'ABMX
QUIT
DO F1^ABMDE8X1
+4 SET ABME("TITL")="PAGE 8F - RADIOLOGY PROCEDURES"
+5 GOTO XIT
+6 ;
G ;EP - Entry Point for Page 8G Errors
+1 IF $DATA(^ABMDPARM(DUZ(2),1,11,5))
QUIT
+2 DO MODE
+3 ;abm*2.6*8
SET ABMX=0
FOR ABMX("I")=1:1
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABMX))
IF 'ABMX
QUIT
DO G1^ABMDE8X1
+4 SET ABME("TITL")="PAGE 8G - ANESTHESIA PROCEDURES"
+5 GOTO XIT
+6 ;
H ;EP - Entry Point for Page 8H Errors
+1 IF $DATA(^ABMDPARM(DUZ(2),1,11,8))
QUIT
+2 DO MODE
+3 ;abm*2.6*8
SET ABMX=0
FOR ABMX("I")=1:1
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABMX))
IF 'ABMX
QUIT
DO H1^ABMDE8X1
+4 SET ABME("TITL")="PAGE 8H - MISC. SERVICES"
+5 GOTO XIT
+6 ;
J ;EP - Entry Point for Page 8J Errors
+1 IF $DATA(^ABMDPARM(DUZ(2),1,11,9))
QUIT
+2 DO MODE
+3 ;abm*2.6*8
SET ABMX=0
FOR ABMX("I")=1:1
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX))
IF 'ABMX
QUIT
Begin DoDot:1
+4 ;abm*2.6*14 to fix <UNDEF>J+16^ABMDE8X
SET ABMX("CPT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,0)),U,7)
+5 IF ^ABMDEXP(ABMMODE(10),0)["UB"
Begin DoDot:2
+6 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,0),"^",5)=""
SET ABME(121)=""
End DoDot:2
+7 IF (^ABMDEXP(ABMMODE(10),0)["HCFA")!(^ABMDEXP(ABMMODE(10),0)["CMS")
Begin DoDot:2
+8 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,0),"^",6)=""
SET ABME(122)=""
+9 SET ABMCODXS=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,0)),U,6)
+10 IF ABMCODXS'=""
Begin DoDot:3
+11 FOR ABMJ=1:1
SET ABMCODX=$PIECE(ABMCODXS,",",ABMJ)
IF +$GET(ABMCODX)=0
QUIT
Begin DoDot:4
+12 ;start new abm*2.6*8 NOHEAT
+13 ;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
+14 ;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")
+15 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0
IF ($GET(ABME(217))="")
SET ABME(217)=ABMX("I")
+16 ;end new
+17 ;abm*2.6*9 NARR
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMX("CPT")))&($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABMX,2)),U,2)="")
Begin DoDot:5
+18 ;abm*2.6*9 NARR
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
QUIT
+19 ;abm*2.6*9 NARR
SET ABME(241)=$SELECT('$DATA(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 SET ABME("TITL")="PAGE 8J - SUPPLIES"
+21 GOTO XIT
K ;EP - Entry Point for Page 8K Errors
+1 IF $DATA(^ABMDPARM(DUZ(2),1,11,8))
QUIT
+2 DO MODE
+3 ;abm*2.6*8
SET ABMX=0
FOR ABMX("I")=1:1
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABMX))
IF 'ABMX
QUIT
DO K1^ABMDE8X1
+4 SET ABME("TITL")="PAGE 8K - AMBULANCE SERVICES"
+5 GOTO XIT
+6 ;
MODE ;EP - SET MODE OF EXPORT ARRAY
+1 NEW I
FOR I=1:1:10
Begin DoDot:1
+2 SET ABMMODE(I)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),70)),"^",I)
+3 IF ABMMODE(I)=""
SET ABMMODE(I)=ABMP("EXP")
End DoDot:1
+4 QUIT
+5 ;
XIT ;
+1 KILL ABMX,ABMMODE,ABMMEDS
+2 QUIT
