ABMERGR2 ; 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
;*******
;
21 ;EP - Med/Surg
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA)) Q:'DA D
.F J=1:2:13,12,14 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0),"^",J)
.S ABMLCNT=+$G(ABMLCNT)+1
.S:ABM(13)="" ABM(13)=1 ;Set default
.S ABM(1)=$S(ABM(1):$P($$CPT^ABMCVAPI(ABM(1),ABMP("VDT")),U,2),1:0) ;CPT code ;CSV-c
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U)=ABM(3) ;Revenue code IEN
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,2)=ABM(1) ;CPT code
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,3)=ABM(9) ;Modifier
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,4)=ABM(11) ;2nd Modifier
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,5)=ABM(13) ;units
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,6)=(ABM(7)*ABM(13)) ;unit charges
.I (ABM(9)="55")!(ABM(11)="55")!(ABM(12)="55") S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,6)=(ABM(7)) ;IHS/SD/AML 2/15/2011 HEAT28973
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,10)=ABM(5) ;From date/time
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,16)=ABM(14) ;Operating Provider
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,8)=ABM(7) ;Unit charge
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,12)=ABM(12) ;3rd Modifier
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,27)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0)),U,19) ;abm*2.6*21 IHS/SD/SDR HEAT120880
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,2)),U) ;abm*2.6*8 5010 LICN
.S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,2)),U,2) ;abm*2.6*9 NARR
.;start new abm*2.6*21 IHS/SD/SDR HEAT106899
.I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","O")) D
..S ABMPIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","O",0))
..S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,16)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P",ABMPIEN,0),U)
.I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","R")) D
..S ABMPIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","R",0))
..S $P(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,18)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P",ABMPIEN,0),U)
.;end new abm*2.6*21 IHS/SD/SDR HEAT106899
.;start new abm*2.6*23 IHS/SD/SDR HEAT347035
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,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"),21,DA,0)),U,23)
..S ABMRV(ABMPO,ABMPO,ABMPO)=$G(ABMRV(+ABM(3),ABM(1),ABMLCNT))
..K ABMRV(+ABM(3),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
;
23 ;EP - Pharmacy
; ABMRV(IEN to REVENUE CODE, Medication IEN)= IEN to REVENUE CODE ^ ^ ^ ^ cumulative units ^ cumulative charges ^ ^ ^ NDC code_" "_generic name ^ date/time ^ ^ ^ ^ Prescription
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA)) Q:'DA D
.;F J=1:1:6,14,22 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),"^",J) ;abm*2.6*6 5010
.;F J=1:1:6,14,22,25 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),"^",J) ;abm*2.6*6 5010 ;abm*2.6*10 HEAT78446
.;F J=1:1:6,14,22,25,29 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),"^",J) ;abm*2.6*10 IHS/SD/AML 8/31/2012 HEAT78446 ;abm*2.6*11
.F J=1:1:6,14,22,24,25,29 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),"^",J) ;abm*2.6*10 IHS/SD/AML 8/31/2012 HEAT78446 ;abm*2.6*11
.S ABM(10)=ABM(14)
.S ABM(14)=ABM(6)
.K ABM(6)
.S:'+ABM(3) ABM(3)=1 ;default units = 1
.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)=$S(+$G(ABM(29))'=0:$P($$CPT^ABMCVAPI(ABM(29),ABMP("VDT")),U,2),$G(ABMP("EXP"))=32:"J3490",1:0) ;abm*2.6*10 IHS/SD/AML 8/31/2012 HEAT78446
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,3)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,3) ;modifier ;abm*2.6*21 IHS/SD/SDR HEAT168435
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,4) ;2nd modifier ;abm*2.6*21 IHS/SD/SDR HEAT168435
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,5)=ABM(3) ;units
.;S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,13)=$S($G(ABM(14))'="":ABM(14),+$G(ABM(22))'=0:$P($G(^PSRX(ABM(22),0)),U),1:"") ;abm*2.6*9 HEAT18507 ;abm*2.6*10 HEAT78446
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,28)=$S($G(ABM(14))'="":ABM(14),+$G(ABM(22))'=0:$P($G(^PSRX(ABM(22),0)),U),1:"") ;Prescription(RX) ;abm*2.6*10 HEAT78446
.S ABM(6)=ABM(3)*ABM(4)+ABM(5) ;units * units cost + dispense fee
.S ABM(6)=$J(ABM(6),1,2)
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(6) ;charges
.;I $$RCID^ABMERUTL(ABMP("INS"))=99999 S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=0 ;abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT ;abm*2.6*21 IHS/SD/SDR HEAT294692
.I $$RCID^ABMERUTL(+$G(ABMP("INS")))=99999 S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=0 ;abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT ;abm*2.6*21 IHS/SD/SDR HEAT294692
.;I ABM(24)'="" S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=ABM(24)_" "_$P($G(^PSDRUG(ABM(1),0)),U) ;NDC generic name ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435
.;I ABM(24)'="" S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=ABM(24) ;NDC ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435 ;abm*2.6*22 IHS/SD/SDR HEAT329144
.;uncommented next line ;abm*2.6*22 IHS/SD/SDR HEAT329144
.I ABM(24)'="" S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=ABM(24)_$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,21)'="UNT":" "_$P($G(^PSDRUG(ABM(1),0)),U),1:"") ;NDC ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435
.;I ABM(24)="" S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$P($G(^PSDRUG(ABM(1),2)),U,4)_" "_$P($G(^PSDRUG(ABM(1),0)),U) ;NDC generic name ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435
.I ABM(24)="" S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$P($G(^PSDRUG(ABM(1),2)),U,4) ;NDC generic name ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$S("^31^32^33^"'[("^"_$G(ABMP("EXP"))_"^"):"N4",1:"")_$P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9) ;abm*2.6*21 IHS/SD/SDR HEAT168435
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(10) ;Date/Time
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,5) ;3rd modifier ;abm*2.6*21 IHS/SD/SDR HEAT168435
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,32)=ABM(25) ;date written
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,27)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0)),U,28) ;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"),23,DA,2)),U) ;abm*2.6*8 5010 line item control number
.;S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,2) ;abm*2.6*9 NARR ;abm*2.6*19 IHS/SD/SDR HEAT173117
.S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,3)),U,2) ;abm*2.6*19 IHS/SD/SDR HEAT173117
.;start new abm*2.6*23 IHS/SD/SDR HEAT347035
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0)),U,30)'=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"),23,DA,0)),U,30)
..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
25 ;EP - Revenue Code
;ABMRV(IEN,0) = IEN to REVENUE CODE ^ ^ ^ ^ Cumulative units ^ Charges ^ ^ Unit charge ^ ^ start date/time
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA)) Q:'DA D
.F J=1:1:7 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,0),"^",J)
.S:'+ABM(2) ABM(2)=1 ;Default units = 1
.S ABMLCNT=+$G(ABMLCNT)+1
.S $P(ABMRV(+ABM(1),0,ABMLCNT),U)=ABM(1) ;Revenue code IEN
.S $P(ABMRV(+ABM(1),0,ABMLCNT),U,2)=$S(+$G(ABM(7))'=0:$P($G(^ICPT(ABM(7),0)),U),1:ABM(7))
.S $P(ABMRV(+ABM(1),0,ABMLCNT),U,5)=ABM(2) ;units
.S $P(ABMRV(+ABM(1),0,ABMLCNT),U,6)=(ABM(2)*ABM(3))+ABM(6) ;Charges
.S $P(ABMRV(+ABM(1),0,ABMLCNT),U,8)=ABM(3) ;Unit charge
.S $P(ABMRV(+ABM(1),0,ABMLCNT),U,10)=ABM(4) ;Start date/time
.S $P(ABMRV(+ABM(1),0,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U) ;abm*2.6*8 5010 LICN
.;start new abm*2.6*23 IHS/SD/SDR HEAT347035
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,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"),25,DA,0)),U,23)
..S ABMRV(ABMPO,ABMPO,ABMPO)=$G(ABMRV(+ABM(1),0,ABMLCNT))
..K ABMRV(+ABM(1),0,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
;
I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,10),'$D(ABMRV(450,0,ABMLCNT)) D
.S ABMRV(450,0,ABMLCNT)=450
.S $P(ABMRV(450,0,ABMLCNT),U,5)=1
.S $P(ABMRV(450,0,ABMLCNT),U,6)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),8),U,10) ;emergency room surcharge
.S $P(ABMRV(450,0,ABMLCNT),U,8)=$P(ABMRV(450,0,ABMLCNT),U,6)
.S $P(ABMRV(450,0,ABMLCNT),U,27)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,0)),U,5) ;abm*2.6*21 IHS/SD/SDR HEAT120880
.S $P(ABMRV(450,0,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U) ;abm*2.6*8 5010 LICN
.S $P(ABMRV(450,0,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U,2) ;abm*2.6*9 NARR
Q
;
27 ;EP - Medical Procedures
D 27^ABMERGR5 ;abm*2.6*23 IHS/SD/SDR split due to size
Q
33 ;EP - Dental
D 33^ABMERGR5 ;abm*2.6*23 IHS/SD/SDR split due to size
Q
35 ;EP - Radiology
D 35^ABMERGR5 ;abm*2.6*23 IHS/SD/SDR split due to size
Q
37 ;EP - Laboratory
D 37^ABMERGR3
Q
39 ;EP - Anesthesia
D 39^ABMERGR3
Q
43 ;EP - Miscellaneous Services
D 43^ABMERGR3
Q
45 ;EP - Supplies
D 45^ABMERGR3
Q
47 ;EP - Ambulance Services
D 47^ABMERGR3
Q
ABMERGR2 ; 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 ;
21 ;EP - Med/Surg
+1 SET DA=0
+2 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA))
IF 'DA
QUIT
Begin DoDot:1
+3 FOR J=1:2:13,12,14
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0),"^",J)
+4 SET ABMLCNT=+$GET(ABMLCNT)+1
+5 ;Set default
IF ABM(13)=""
SET ABM(13)=1
+6 ;CPT code ;CSV-c
SET ABM(1)=$SELECT(ABM(1):$PIECE($$CPT^ABMCVAPI(ABM(1),ABMP("VDT")),U,2),1:0)
+7 ;Revenue code IEN
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U)=ABM(3)
+8 ;CPT code
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,2)=ABM(1)
+9 ;Modifier
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,3)=ABM(9)
+10 ;2nd Modifier
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,4)=ABM(11)
+11 ;units
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,5)=ABM(13)
+12 ;unit charges
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,6)=(ABM(7)*ABM(13))
+13 ;IHS/SD/AML 2/15/2011 HEAT28973
IF (ABM(9)="55")!(ABM(11)="55")!(ABM(12)="55")
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,6)=(ABM(7))
+14 ;From date/time
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,10)=ABM(5)
+15 ;Operating Provider
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,16)=ABM(14)
+16 ;Unit charge
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,8)=ABM(7)
+17 ;3rd Modifier
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,12)=ABM(12)
+18 ;abm*2.6*21 IHS/SD/SDR HEAT120880
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,27)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0)),U,19)
+19 ;abm*2.6*8 5010 LICN
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,2)),U)
+20 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,2)),U,2)
+21 ;start new abm*2.6*21 IHS/SD/SDR HEAT106899
+22 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","O"))
Begin DoDot:2
+23 SET ABMPIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","O",0))
+24 SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,16)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P",ABMPIEN,0),U)
End DoDot:2
+25 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","R"))
Begin DoDot:2
+26 SET ABMPIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","R",0))
+27 SET $PIECE(ABMRV(+ABM(3),ABM(1),ABMLCNT),U,18)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P",ABMPIEN,0),U)
End DoDot:2
+28 ;end new abm*2.6*21 IHS/SD/SDR HEAT106899
+29 ;start new abm*2.6*23 IHS/SD/SDR HEAT347035
+30 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0)),U,23)'=0
Begin DoDot:2
+31 ;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
+32 SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0)),U,23)
+33 SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(+ABM(3),ABM(1),ABMLCNT))
+34 KILL ABMRV(+ABM(3),ABM(1),ABMLCNT)
+35 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
+36 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
+37 ;end new abm*2.6*23 IHS/SD/SDR HEAT347035
End DoDot:1
+38 QUIT
+39 ;
23 ;EP - Pharmacy
+1 ; ABMRV(IEN to REVENUE CODE, Medication IEN)= IEN to REVENUE CODE ^ ^ ^ ^ cumulative units ^ cumulative charges ^ ^ ^ NDC code_" "_generic name ^ date/time ^ ^ ^ ^ Prescription
+2 SET DA=0
+3 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA))
IF 'DA
QUIT
Begin DoDot:1
+4 ;F J=1:1:6,14,22 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),"^",J) ;abm*2.6*6 5010
+5 ;F J=1:1:6,14,22,25 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),"^",J) ;abm*2.6*6 5010 ;abm*2.6*10 HEAT78446
+6 ;F J=1:1:6,14,22,25,29 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),"^",J) ;abm*2.6*10 IHS/SD/AML 8/31/2012 HEAT78446 ;abm*2.6*11
+7 ;abm*2.6*10 IHS/SD/AML 8/31/2012 HEAT78446 ;abm*2.6*11
FOR J=1:1:6,14,22,24,25,29
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),"^",J)
+8 SET ABM(10)=ABM(14)
+9 SET ABM(14)=ABM(6)
+10 KILL ABM(6)
+11 ;default units = 1
IF '+ABM(3)
SET ABM(3)=1
+12 SET ABMLCNT=+$GET(ABMLCNT)+1
+13 ;revenue code IEN
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U)=ABM(2)
+14 ;abm*2.6*10 IHS/SD/AML 8/31/2012 HEAT78446
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,2)=$SELECT(+$GET(ABM(29))'=0:$PIECE($$CPT^ABMCVAPI(ABM(29),ABMP("VDT")),U,2),$GET(ABMP("EXP"))=32:"J3490",1:0)
+15 ;modifier ;abm*2.6*21 IHS/SD/SDR HEAT168435
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,3)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,3)
+16 ;2nd modifier ;abm*2.6*21 IHS/SD/SDR HEAT168435
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,4)
+17 ;units
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,5)=ABM(3)
+18 ;S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,13)=$S($G(ABM(14))'="":ABM(14),+$G(ABM(22))'=0:$P($G(^PSRX(ABM(22),0)),U),1:"") ;abm*2.6*9 HEAT18507 ;abm*2.6*10 HEAT78446
+19 ;Prescription(RX) ;abm*2.6*10 HEAT78446
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,28)=$SELECT($GET(ABM(14))'="":ABM(14),+$GET(ABM(22))'=0:$PIECE($GET(^PSRX(ABM(22),0)),U),1:"")
+20 ;units * units cost + dispense fee
SET ABM(6)=ABM(3)*ABM(4)+ABM(5)
+21 SET ABM(6)=$JUSTIFY(ABM(6),1,2)
+22 ;charges
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(6)
+23 ;I $$RCID^ABMERUTL(ABMP("INS"))=99999 S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=0 ;abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT ;abm*2.6*21 IHS/SD/SDR HEAT294692
+24 ;abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT ;abm*2.6*21 IHS/SD/SDR HEAT294692
IF $$RCID^ABMERUTL(+$GET(ABMP("INS")))=99999
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=0
+25 ;I ABM(24)'="" S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=ABM(24)_" "_$P($G(^PSDRUG(ABM(1),0)),U) ;NDC generic name ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435
+26 ;I ABM(24)'="" S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=ABM(24) ;NDC ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435 ;abm*2.6*22 IHS/SD/SDR HEAT329144
+27 ;uncommented next line ;abm*2.6*22 IHS/SD/SDR HEAT329144
+28 ;NDC ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435
IF ABM(24)'=""
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=ABM(24)_$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,21)'="UNT":" "_$PIECE($GET(^PSDRUG(ABM(1),0)),U),1:"")
+29 ;I ABM(24)="" S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$P($G(^PSDRUG(ABM(1),2)),U,4)_" "_$P($G(^PSDRUG(ABM(1),0)),U) ;NDC generic name ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435
+30 ;NDC generic name ;abm*2.6*11 ;abm*2.6*21 IHS/SD/SDR HEAT168435
IF ABM(24)=""
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$PIECE($GET(^PSDRUG(ABM(1),2)),U,4)
+31 ;abm*2.6*21 IHS/SD/SDR HEAT168435
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$SELECT("^31^32^33^"'[("^"_$GET(ABMP("EXP"))_"^"):"N4",1:"")_$PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)
+32 ;Date/Time
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(10)
+33 ;3rd modifier ;abm*2.6*21 IHS/SD/SDR HEAT168435
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,5)
+34 ;date written
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,32)=ABM(25)
+35 ;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"),23,DA,0)),U,28)
+36 ;abm*2.6*8 5010 line item control number
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U)
+37 ;S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,2) ;abm*2.6*9 NARR ;abm*2.6*19 IHS/SD/SDR HEAT173117
+38 ;abm*2.6*19 IHS/SD/SDR HEAT173117
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,3)),U,2)
+39 ;start new abm*2.6*23 IHS/SD/SDR HEAT347035
+40 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0)),U,30)'=0
Begin DoDot:2
+41 ;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
+42 SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0)),U,30)
+43 SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(+ABM(2),ABM(1),ABMLCNT))
+44 KILL ABMRV(+ABM(2),ABM(1),ABMLCNT)
+45 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
+46 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
+47 ;end new abm*2.6*23 IHS/SD/SDR HEAT347035
End DoDot:1
+48 QUIT
25 ;EP - Revenue Code
+1 ;ABMRV(IEN,0) = IEN to REVENUE CODE ^ ^ ^ ^ Cumulative units ^ Charges ^ ^ Unit charge ^ ^ start date/time
+2 SET DA=0
+3 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA))
IF 'DA
QUIT
Begin DoDot:1
+4 FOR J=1:1:7
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,0),"^",J)
+5 ;Default units = 1
IF '+ABM(2)
SET ABM(2)=1
+6 SET ABMLCNT=+$GET(ABMLCNT)+1
+7 ;Revenue code IEN
SET $PIECE(ABMRV(+ABM(1),0,ABMLCNT),U)=ABM(1)
+8 SET $PIECE(ABMRV(+ABM(1),0,ABMLCNT),U,2)=$SELECT(+$GET(ABM(7))'=0:$PIECE($GET(^ICPT(ABM(7),0)),U),1:ABM(7))
+9 ;units
SET $PIECE(ABMRV(+ABM(1),0,ABMLCNT),U,5)=ABM(2)
+10 ;Charges
SET $PIECE(ABMRV(+ABM(1),0,ABMLCNT),U,6)=(ABM(2)*ABM(3))+ABM(6)
+11 ;Unit charge
SET $PIECE(ABMRV(+ABM(1),0,ABMLCNT),U,8)=ABM(3)
+12 ;Start date/time
SET $PIECE(ABMRV(+ABM(1),0,ABMLCNT),U,10)=ABM(4)
+13 ;abm*2.6*8 5010 LICN
SET $PIECE(ABMRV(+ABM(1),0,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U)
+14 ;start new abm*2.6*23 IHS/SD/SDR HEAT347035
+15 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,0)),U,23)'=0
Begin DoDot:2
+16 ;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
+17 SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,0)),U,23)
+18 SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(+ABM(1),0,ABMLCNT))
+19 KILL ABMRV(+ABM(1),0,ABMLCNT)
+20 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
+21 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
+22 ;end new abm*2.6*23 IHS/SD/SDR HEAT347035
End DoDot:1
+23 ;
+24 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,10)
IF '$DATA(ABMRV(450,0,ABMLCNT))
Begin DoDot:1
+25 SET ABMRV(450,0,ABMLCNT)=450
+26 SET $PIECE(ABMRV(450,0,ABMLCNT),U,5)=1
+27 ;emergency room surcharge
SET $PIECE(ABMRV(450,0,ABMLCNT),U,6)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),8),U,10)
+28 SET $PIECE(ABMRV(450,0,ABMLCNT),U,8)=$PIECE(ABMRV(450,0,ABMLCNT),U,6)
+29 ;abm*2.6*21 IHS/SD/SDR HEAT120880
SET $PIECE(ABMRV(450,0,ABMLCNT),U,27)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,0)),U,5)
+30 ;abm*2.6*8 5010 LICN
SET $PIECE(ABMRV(450,0,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U)
+31 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(450,0,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U,2)
End DoDot:1
+32 QUIT
+33 ;
27 ;EP - Medical Procedures
+1 ;abm*2.6*23 IHS/SD/SDR split due to size
DO 27^ABMERGR5
+2 QUIT
33 ;EP - Dental
+1 ;abm*2.6*23 IHS/SD/SDR split due to size
DO 33^ABMERGR5
+2 QUIT
35 ;EP - Radiology
+1 ;abm*2.6*23 IHS/SD/SDR split due to size
DO 35^ABMERGR5
+2 QUIT
37 ;EP - Laboratory
+1 DO 37^ABMERGR3
+2 QUIT
39 ;EP - Anesthesia
+1 DO 39^ABMERGR3
+2 QUIT
43 ;EP - Miscellaneous Services
+1 DO 43^ABMERGR3
+2 QUIT
45 ;EP - Supplies
+1 DO 45^ABMERGR3
+2 QUIT
47 ;EP - Ambulance Services
+1 DO 47^ABMERGR3
+2 QUIT
