ABMERGR2.m

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