ABMERGR5 ; IHS/SD/SDR - GET ANCILLARY SVCS REVENUE CODE INFO ;
;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,10,11,19,20,21,22,23**;NOV 12, 2009;Build 427
;
;IHS/SD/LSL 08/30/02 V2.5 Patch 1 HIPAA Added prescription number as 14th piece of ABMRV array for Pharmacy
;IHS/SD/SDR V2.5 P2 5/9/02 NOIS HQW-0302-100190 Modified to display 2nd and 3rd modifiers and units
;IHS/SD/EFG V2.5 P8 IM16385 Correction to calculate cumulative charges correctly for dental
;IHS/SD/SDR v2.5 p8 task 6 Added new ambulance multiple 47
;IHS/SD/SDR v2.5 p9 IM19492 Corrected HCPCS issue (was +'ing HCPCS, making it 0)
;IHS/SD/SDR v2.5 p9 split for routine size ABMERGR3
;IHS/SD/SDR v2.5 p10 IM20018 Added code to get CPT code on Revenue code page
;IHS/SD/SDR v2.5 p10 IM20395 Split out lines bundled by Rev Code. NOTE: old code removed due to routine size
;IHS/SD/SDR v2.5 p11 IM24135 Fixed Rx number not printing (wasn't looking at both fields)
;IHS/SD/SDR v2.5 p12 IM25207 Changed default to RX number
;IHS/SD/SDR v2.5 p12 IM25947 Don't include dental charges if not doing ADA billing
;
;IHS/SD/SDR v2.6 CSV
;IHS/SD/SDR 2.6*6 5010 added date written
;IHS/SD/SDR 2.6*6 HEAT28973 if 55 modifier present use '1' for units to calculate charges
;IHS/SD/SDR 2.6*9 HEAT18507 Fixed where RX number was coming from (p14, not p6)
;IHS/SD/SDR 2.6*19 HEAT173117 Correction to CPT Narrative for 23 multiple.
;IHS/SD/AML 2.6*20 HEAT262141 AHCCCS RX billing.
;IHS/SD/SDR 2.6*21 HEAT106899 Get operating and rendering provider for 21 mult.
;IHS/SD/SDR 2.6*21 HEAT120880 Added SERVICE DATE TO in ABMRV array for all multiples.
;IHS/SD/SDR 2.6*21 HEAT168435 Added pharmacy modifiers (23 mult).
;IHS/SD/SDR 2.6*21 HEAT294086 Change for <UNDEF>23+25^ABMERGR2.
;IHS/SD/SDR 2.6*22 HEAT329144 Added print the medication name based on new parameter.
;IHS/SD/SDR 2.6*23 HEAT347035 Changed subscripts if print order is populated
;***********
; All line tags adhere to following description unless specified otherwise in the appropriate line tag:
;
; ABMRV(IEN to REVENUE CODE, CPT CODE)= IEN to REVENUE CODE ^ CPT Code ^ Modifier ^ 2nd modifier ^ cumulative units ^ cumulative
; charges ^ ^ Unit Charge ^ NDC/ADA ^ from date/time ^ 3rd Modifier ^ 4th Modifier ^ Prescription ^ Attending Provider
; ^ Operating Provider ^ Referring Provider ^ Other Provider
;*******
;
27 ;EP - Medical Procedures
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA)) Q:'DA D
.F J=1:1:10 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0),"^",J)
.S:'+ABM(3) ABM(3)=1
.S ABM(1)=$S(ABM(1):$P($$CPT^ABMCVAPI(ABM(1),ABMP("VDT")),U,2),1:0) ;CPT code ;CSV-c
.S ABMLCNT=+$G(ABMLCNT)+1
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U)=ABM(2) ;Revenue code IEN
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,2)=ABM(1) ;CPT code
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,3)=ABM(5) ;Modifier
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=ABM(8) ;2nd modifier
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,5)=ABM(3) ;cumulative units
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=(ABM(3)*ABM(4)) ;cumulative charges
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,15)=ABM(10) ;Attending Provider
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,8)=ABM(4) ;Unit Charge
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(7) ;Date/Time
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(9) ;3rd Modifier
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,27)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,12) ;abm*2.6*21 IHS/SD/SDR HEAT120880
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,2)),U) ;abm*2.6*8 5010 LICN
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,2)),U,2) ;abm*2.6*9 NARR
.;start new abm*2.6*23 IHS/SD/SDR HEAT347035
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,23)'=0 D
..I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,24)'="Y" Q ;don't do print order if parameter is off
..S ABMPO=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,23)
..S ABMRV(ABMPO,ABMPO,ABMPO)=$G(ABMRV(+ABM(2),ABM(1),ABMLCNT))
..K ABMRV(+ABM(2),ABM(1),ABMLCNT)
..I +$P(ABMRV(ABMPO,ABMPO,ABMPO),U,6)=0 S $P(ABMRV(ABMPO,ABMPO,ABMPO),U)=0,$P(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0
..I $$RCID^ABMUTLP(ABMP("INS"))["61044",$P(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0 S $P(ABMRV(ABMPO,ABMPO,ABMPO),U,5)="00"
.;end new abm*2.6*23 IHS/SD/SDR HEAT347035
Q
33 ;EP - Dental
; ABMRV(IEN, Dental Code) = IEN to REVENUE CODE ^ Dental code ^ ^ ^ Cumulative units ^ Cumulative charges ^ ^ ^ ADA Description ^ Date of Service
S DA=0
I $G(ABMP("LDFN"))'="",($G(ABMP("INS"))'=""),($G(ABMP("VTYP"))'="") Q:$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,2)'="A"
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA)) Q:'DA D
.F J=1,2,7,8,9 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0),"^",J)
.S:'+ABM(9) ABM(9)=1
.S ABM("DCODE")=$P(^AUTTADA(ABM(1),0),U) ;dental code
.;start new abm*2.6*11 HEAT90370
.S ABMDENP=$P($G(^ABMDREC(ABMP("INS"),0)),U,2)
.S:ABMDENP="" ABMDENP=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,11)
.S:ABMDENP="" ABMDENP=$P($G(^ABMDPARM(DUZ(2),1,3)),U,11)
.S:ABMDENP]"" ABM("DCODE")=ABMDENP_ABM("DCODE")
.;end new HEAT90370
.S ABMLCNT=+$G(ABMLCNT)+1
.S $P(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U)=ABM(2) ;Rev code IEN
.S $P(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,2)=ABM("DCODE") ;Dental code
.S $P(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,5)=ABM(9) ;units
.S $P(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,6)=(ABM(8)*ABM(9)) ;charges
.S $P(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,9)=$P(^AUTTADA(ABM(1),0),U,2) ;ADA Desc
.S $P(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,10)=ABM(7) ;DoS
.S $P(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,27)=ABM(7) ;abm*2.6*21 IHS/SD/SDR HEAT120880
.S $P(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,2)),U) ;abm*2.6*8 5010 LICN
.S $P(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,2)),U,2) ;abm*2.6*9 NARR
.;start new abm*2.6*23 IHS/SD/SDR HEAT347035
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0)),U,23)'=0 D
..I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,24)'="Y" Q ;don't do print order if parameter is off
..S ABMPO=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0)),U,23)
..S ABMRV(ABMPO,ABMPO,ABMPO)=$G(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT))
..K ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT)
..I +$P(ABMRV(ABMPO,ABMPO,ABMPO),U,6)=0 S $P(ABMRV(ABMPO,ABMPO,ABMPO),U)=0,$P(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0
..I $$RCID^ABMUTLP(ABMP("INS"))["61044",$P(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0 S $P(ABMRV(ABMPO,ABMPO,ABMPO),U,5)="00"
.;end new abm*2.6*23 IHS/SD/SDR HEAT347035
Q
35 ;EP - Radiology
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA)) Q:'DA D
.F J=1:1:10 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0),"^",J)
.S:'+ABM(3) ABM(3)=1
.S ABM(1)=$S(ABM(1):$P($$CPT^ABMCVAPI(ABM(1),ABMP("VDT")),U,2),1:0) ;CPT Code ;CSV-c
.S ABMLCNT=+$G(ABMLCNT)+1
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U)=ABM(2) ;Revenue code IEN
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,2)=ABM(1) ;CPT Code
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,3)=ABM(5) ;Modifier
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=ABM(6) ;2nd Modifier
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,5)=ABM(3) ;units
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=(ABM(3)*ABM(4)) ;charges
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,8)=ABM(4) ;Unit Charge
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(9) ;Date/Time
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(7) ;3rd Modifier
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,15)=ABM(10) ;Attending Provider
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,27)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,12) ;abm*2.6*21 IHS/SD/SDR HEAT120880
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,2)),U) ;abm*2.6*8 5010 LICN
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,2)),U,2) ;abm*2.6*9 NARR
.;start new abm*2.6*23 IHS/SD/SDR HEAT347035
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,23)'=0 D
..I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,24)'="Y" Q ;don't do print order if parameter is off
..S ABMPO=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,23)
..S ABMRV(ABMPO,ABMPO,ABMPO)=$G(ABMRV(+ABM(2),ABM(1),ABMLCNT))
..K ABMRV(+ABM(2),ABM(1),ABMLCNT)
..I +$P(ABMRV(ABMPO,ABMPO,ABMPO),U,6)=0 S $P(ABMRV(ABMPO,ABMPO,ABMPO),U)=0,$P(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0
..I $$RCID^ABMUTLP(ABMP("INS"))["61044",$P(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0 S $P(ABMRV(ABMPO,ABMPO,ABMPO),U,5)="00"
.;end new abm*2.6*23 IHS/SD/SDR HEAT347035
Q
ABMERGR5 ; IHS/SD/SDR - GET ANCILLARY SVCS REVENUE CODE INFO ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,10,11,19,20,21,22,23**;NOV 12, 2009;Build 427
+2 ;
+3 ;IHS/SD/LSL 08/30/02 V2.5 Patch 1 HIPAA Added prescription number as 14th piece of ABMRV array for Pharmacy
+4 ;IHS/SD/SDR V2.5 P2 5/9/02 NOIS HQW-0302-100190 Modified to display 2nd and 3rd modifiers and units
+5 ;IHS/SD/EFG V2.5 P8 IM16385 Correction to calculate cumulative charges correctly for dental
+6 ;IHS/SD/SDR v2.5 p8 task 6 Added new ambulance multiple 47
+7 ;IHS/SD/SDR v2.5 p9 IM19492 Corrected HCPCS issue (was +'ing HCPCS, making it 0)
+8 ;IHS/SD/SDR v2.5 p9 split for routine size ABMERGR3
+9 ;IHS/SD/SDR v2.5 p10 IM20018 Added code to get CPT code on Revenue code page
+10 ;IHS/SD/SDR v2.5 p10 IM20395 Split out lines bundled by Rev Code. NOTE: old code removed due to routine size
+11 ;IHS/SD/SDR v2.5 p11 IM24135 Fixed Rx number not printing (wasn't looking at both fields)
+12 ;IHS/SD/SDR v2.5 p12 IM25207 Changed default to RX number
+13 ;IHS/SD/SDR v2.5 p12 IM25947 Don't include dental charges if not doing ADA billing
+14 ;
+15 ;IHS/SD/SDR v2.6 CSV
+16 ;IHS/SD/SDR 2.6*6 5010 added date written
+17 ;IHS/SD/SDR 2.6*6 HEAT28973 if 55 modifier present use '1' for units to calculate charges
+18 ;IHS/SD/SDR 2.6*9 HEAT18507 Fixed where RX number was coming from (p14, not p6)
+19 ;IHS/SD/SDR 2.6*19 HEAT173117 Correction to CPT Narrative for 23 multiple.
+20 ;IHS/SD/AML 2.6*20 HEAT262141 AHCCCS RX billing.
+21 ;IHS/SD/SDR 2.6*21 HEAT106899 Get operating and rendering provider for 21 mult.
+22 ;IHS/SD/SDR 2.6*21 HEAT120880 Added SERVICE DATE TO in ABMRV array for all multiples.
+23 ;IHS/SD/SDR 2.6*21 HEAT168435 Added pharmacy modifiers (23 mult).
+24 ;IHS/SD/SDR 2.6*21 HEAT294086 Change for <UNDEF>23+25^ABMERGR2.
+25 ;IHS/SD/SDR 2.6*22 HEAT329144 Added print the medication name based on new parameter.
+26 ;IHS/SD/SDR 2.6*23 HEAT347035 Changed subscripts if print order is populated
+27 ;***********
+28 ; All line tags adhere to following description unless specified otherwise in the appropriate line tag:
+29 ;
+30 ; ABMRV(IEN to REVENUE CODE, CPT CODE)= IEN to REVENUE CODE ^ CPT Code ^ Modifier ^ 2nd modifier ^ cumulative units ^ cumulative
+31 ; charges ^ ^ Unit Charge ^ NDC/ADA ^ from date/time ^ 3rd Modifier ^ 4th Modifier ^ Prescription ^ Attending Provider
+32 ; ^ Operating Provider ^ Referring Provider ^ Other Provider
+33 ;*******
+34 ;
27 ;EP - Medical Procedures
+1 SET DA=0
+2 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA))
IF 'DA
QUIT
Begin DoDot:1
+3 FOR J=1:1:10
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0),"^",J)
+4 IF '+ABM(3)
SET ABM(3)=1
+5 ;CPT code ;CSV-c
SET ABM(1)=$SELECT(ABM(1):$PIECE($$CPT^ABMCVAPI(ABM(1),ABMP("VDT")),U,2),1:0)
+6 SET ABMLCNT=+$GET(ABMLCNT)+1
+7 ;Revenue code IEN
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U)=ABM(2)
+8 ;CPT code
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,2)=ABM(1)
+9 ;Modifier
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,3)=ABM(5)
+10 ;2nd modifier
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=ABM(8)
+11 ;cumulative units
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,5)=ABM(3)
+12 ;cumulative charges
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=(ABM(3)*ABM(4))
+13 ;Attending Provider
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,15)=ABM(10)
+14 ;Unit Charge
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,8)=ABM(4)
+15 ;Date/Time
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(7)
+16 ;3rd Modifier
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(9)
+17 ;abm*2.6*21 IHS/SD/SDR HEAT120880
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,27)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,12)
+18 ;abm*2.6*8 5010 LICN
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,2)),U)
+19 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,2)),U,2)
+20 ;start new abm*2.6*23 IHS/SD/SDR HEAT347035
+21 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,23)'=0
Begin DoDot:2
+22 ;don't do print order if parameter is off
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,24)'="Y"
QUIT
+23 SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,23)
+24 SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(+ABM(2),ABM(1),ABMLCNT))
+25 KILL ABMRV(+ABM(2),ABM(1),ABMLCNT)
+26 IF +$PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,6)=0
SET $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U)=0
SET $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0
+27 IF $$RCID^ABMUTLP(ABMP("INS"))["61044"
IF $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0
SET $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,5)="00"
End DoDot:2
+28 ;end new abm*2.6*23 IHS/SD/SDR HEAT347035
End DoDot:1
+29 QUIT
33 ;EP - Dental
+1 ; ABMRV(IEN, Dental Code) = IEN to REVENUE CODE ^ Dental code ^ ^ ^ Cumulative units ^ Cumulative charges ^ ^ ^ ADA Description ^ Date of Service
+2 SET DA=0
+3 IF $GET(ABMP("LDFN"))'=""
IF ($GET(ABMP("INS"))'="")
IF ($GET(ABMP("VTYP"))'="")
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,2)'="A"
QUIT
+4 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA))
IF 'DA
QUIT
Begin DoDot:1
+5 FOR J=1,2,7,8,9
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0),"^",J)
+6 IF '+ABM(9)
SET ABM(9)=1
+7 ;dental code
SET ABM("DCODE")=$PIECE(^AUTTADA(ABM(1),0),U)
+8 ;start new abm*2.6*11 HEAT90370
+9 SET ABMDENP=$PIECE($GET(^ABMDREC(ABMP("INS"),0)),U,2)
+10 IF ABMDENP=""
SET ABMDENP=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,11)
+11 IF ABMDENP=""
SET ABMDENP=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),U,11)
+12 IF ABMDENP]""
SET ABM("DCODE")=ABMDENP_ABM("DCODE")
+13 ;end new HEAT90370
+14 SET ABMLCNT=+$GET(ABMLCNT)+1
+15 ;Rev code IEN
SET $PIECE(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U)=ABM(2)
+16 ;Dental code
SET $PIECE(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,2)=ABM("DCODE")
+17 ;units
SET $PIECE(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,5)=ABM(9)
+18 ;charges
SET $PIECE(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,6)=(ABM(8)*ABM(9))
+19 ;ADA Desc
SET $PIECE(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,9)=$PIECE(^AUTTADA(ABM(1),0),U,2)
+20 ;DoS
SET $PIECE(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,10)=ABM(7)
+21 ;abm*2.6*21 IHS/SD/SDR HEAT120880
SET $PIECE(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,27)=ABM(7)
+22 ;abm*2.6*8 5010 LICN
SET $PIECE(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,2)),U)
+23 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,2)),U,2)
+24 ;start new abm*2.6*23 IHS/SD/SDR HEAT347035
+25 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0)),U,23)'=0
Begin DoDot:2
+26 ;don't do print order if parameter is off
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,24)'="Y"
QUIT
+27 SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0)),U,23)
+28 SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT))
+29 KILL ABMRV(+ABM(2),+ABM("DCODE"),ABMLCNT)
+30 IF +$PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,6)=0
SET $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U)=0
SET $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0
+31 IF $$RCID^ABMUTLP(ABMP("INS"))["61044"
IF $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0
SET $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,5)="00"
End DoDot:2
+32 ;end new abm*2.6*23 IHS/SD/SDR HEAT347035
End DoDot:1
+33 QUIT
35 ;EP - Radiology
+1 SET DA=0
+2 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA))
IF 'DA
QUIT
Begin DoDot:1
+3 FOR J=1:1:10
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0),"^",J)
+4 IF '+ABM(3)
SET ABM(3)=1
+5 ;CPT Code ;CSV-c
SET ABM(1)=$SELECT(ABM(1):$PIECE($$CPT^ABMCVAPI(ABM(1),ABMP("VDT")),U,2),1:0)
+6 SET ABMLCNT=+$GET(ABMLCNT)+1
+7 ;Revenue code IEN
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U)=ABM(2)
+8 ;CPT Code
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,2)=ABM(1)
+9 ;Modifier
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,3)=ABM(5)
+10 ;2nd Modifier
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=ABM(6)
+11 ;units
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,5)=ABM(3)
+12 ;charges
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=(ABM(3)*ABM(4))
+13 ;Unit Charge
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,8)=ABM(4)
+14 ;Date/Time
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(9)
+15 ;3rd Modifier
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(7)
+16 ;Attending Provider
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,15)=ABM(10)
+17 ;abm*2.6*21 IHS/SD/SDR HEAT120880
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,27)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,12)
+18 ;abm*2.6*8 5010 LICN
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,2)),U)
+19 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,2)),U,2)
+20 ;start new abm*2.6*23 IHS/SD/SDR HEAT347035
+21 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,23)'=0
Begin DoDot:2
+22 ;don't do print order if parameter is off
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,24)'="Y"
QUIT
+23 SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,23)
+24 SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(+ABM(2),ABM(1),ABMLCNT))
+25 KILL ABMRV(+ABM(2),ABM(1),ABMLCNT)
+26 IF +$PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,6)=0
SET $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U)=0
SET $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0
+27 IF $$RCID^ABMUTLP(ABMP("INS"))["61044"
IF $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,5)=0
SET $PIECE(ABMRV(ABMPO,ABMPO,ABMPO),U,5)="00"
End DoDot:2
+28 ;end new abm*2.6*23 IHS/SD/SDR HEAT347035
End DoDot:1
+29 QUIT
