ABMERGR3.m

ABMERGR3 ; IHS/SD/SDR - GET ANCILLARY SVCS REVENUE CODE INFO ; 

 ;;2.6;IHS Third Party Billing;**1,3,6,8,9,14,21,23**;NOV 12, 2009;Build 427

 ;Original;DMJ;03/20/96 9:07 AM

 ;

 ;IHS/SD/SDR v2.5 p9 - split routine for size

 ;IHS/SD/SDR v2.5 p10 - IM20395 - Split out lines bundled by Rev code

 ;IHS/SD/SDR v2.5 p10 - IM21539 - Made anes amt just use base charge

 ;IHS/SD/SDR v2.5 p12 - IM24093 - Put description in array if J-code

 ;

 ;IHS/SD/SDR v2.6 CSV

 ;IHS/SD/SDR 2.6*1 HEAT6566 - Populate anes based on MCR/non-MCR

 ;IHS/SD/SDR 2.6*3 HEAT12742 - Correction to MCR/non-MCR; removed all HEAT6566 changes

 ;IHS/SD/SDR 2.6*6 5010 - added 5010 prompts to 43 multiple

 ;IHS/SD/SDR 2.6*21 HEAT106899 - Get operating and rendering provider for 43 mult.

 ;IHS/SD/SDR 2.6*21 HEAT120880 Added code for SERVICE DATE TO in ABMRV array for all multiples.

 ;IHS/SD/AML 2.6*23 HEAT247169 For 43 subfile add NDC to array

 ;IHS/SD/SDR 2.6*23 HEAT347035 Changed subscripts if there is a print order to be used

 ;

37 ;EP - Laboratory

 S DA=0

 F  S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA)) Q:'DA  D

 .F J=1:1:8 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,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(6)  ;Modifier

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=ABM(7)  ;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(5)  ;Date/Time

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(8)  ;3rd Modifier

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,27)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,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"),37,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"),37,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"),37,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"),37,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

39 ;EP - Anesthesia

 S DA=0

 F  S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA)) Q:'DA  D

 .F J=1:1:6,11,14,19 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,0),"^",J)

 .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(6)  ;Modifier

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=ABM(14)  ;2nd Modifier

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,5)=1  ;units

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(4)  ;charges  ;abm*2.6*1 HEAT6566

 .;I ($G(ABMP("ITYP"))'="R")!($G(ABMP("ITYPE"))'="R") S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(4)  ;charges  ;abm*2.6*1 HEAT6566  abm*2.6*3 HEAT12742

 .;I ($G(ABMP("ITYP"))="R")!($G(ABMP("ITYPE"))="R") S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(4)  ;charges  ;abm*2.6*3 HEAT12742

 .;I ($G(ABMP("ITYP"))="R")!($G(ABMP("ITYPE"))="R") S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(3)+ABM(4)  ;charges  ;abm*2.6*1 HEAT6566abm*2.6*3 HEAT12742

 .;I ($G(ABMP("ITYP"))'="R")!($G(ABMP("ITYPE"))'="R") S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(3)+ABM(4)  ;charges  ;abm*2.6*3 HEAT12742

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(5)  ;Date/time of service

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(19)  ;3rd Modifier

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,18)=ABM(11)  ;Other Provider

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,27)=ABM(5)  ;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"),39,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"),39,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"),39,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"),39,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

 ;

43 ;EP - Miscellaneous Services

 S DA=0

 F  S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA)) Q:'DA  D

 .F J=1:1:9 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,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)  ;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

 .I $E($P($$CPT^ABMCVAPI($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U),ABMP("VDT")),U,2),1)="J" D  ;CSV-c

 ..S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$P($$CPT^ABMCVAPI($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U),ABMP("VDT")),U,3)  ;description for J-codes only ;CSV-c

 .I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,19)'="" S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,19)_" "_$P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)  ;NDC  ;abm*2.6*23 IHS/SD/SDR HEAT247169

 .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

 .;start new code abm*2.6*6 5010

 .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,1)) $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,33)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,1)  ;QTY/LENGTH MEDICAL NECESSITY

 .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,2)) $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,34)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,2)  ;MONETARY AMT/DME RENTAL PRICE

 .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,3)) $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,35)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,3)  ;MONETARY AMT/DME PURCH. PRICE

 .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,4)) $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,36)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,4)  ;FRQ CODE/RENTAL UNIT PRICE IND

 .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,5)) $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,37)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,5)  ;immun. batch

 .;end new code 5010

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,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"),43,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"),43,DA,"P","C","O")) D

 ..S ABMPIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","O",0))

 ..S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,16)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P",ABMPIEN,0),U)

 .I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","R")) D

 ..S ABMPIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","R",0))

 ..S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,18)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P",ABMPIEN,0),U)

 .;end new abm*2.6*21 IHS/SD/SDR HEAT106899

 .S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,27)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,12)  ;abm*2.6*21 IHS/SD/SDR HEAT120880

 .;start new abm*2.6*23 IHS/SD/SDR HEAT347035

 .I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,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"),43,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

45 ;EP - Supplies

 S DA=0

 F  S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA)) Q:'DA  D

 .F J=1:1:7 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,0),"^",J)

 .S:'+ABM(3) ABM(3)=1

 .I ABM(5)="" S ABM(5)=270

 .S ABM(7)=$P($$CPT^ABMCVAPI(+ABM(7),ABMP("VDT")),U,2)  ;CSV-c

 .S:ABM(7)="" ABM(7)=0

 .S ABMLCNT=+$G(ABMLCNT)+1

 .S ABMRV(ABM(5),ABM(7),ABMLCNT)=ABM(5)  ;Revenue code

 .S $P(ABMRV(ABM(5),ABM(7),ABMLCNT),U,2)=ABM(7)  ;CPT Code

 .S $P(ABMRV(ABM(5),ABM(7),ABMLCNT),U,5)=ABM(3)  ;units

 .S $P(ABMRV(ABM(5),ABM(7),ABMLCNT),U,6)=(ABM(3)*ABM(4))  ;charges

 .S $P(ABMRV(ABM(5),ABM(7),ABMLCNT),U,10)=ABM(2)

 .S $P(ABMRV(ABM(5),ABM(7),ABMLCNT),U,8)=ABM(4)

 .S $P(ABMRV(+ABM(5),ABM(7),ABMLCNT),U,27)=ABM(2)  ;abm*2.6*21 IHS/SD/SDR HEAT120880

 .S $P(ABMRV(ABM(5),ABM(7),ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,2)),U)  ;abm*2.6*8 5010 line item control number

 .S $P(ABMRV(ABM(5),ABM(7),ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,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"),45,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"),45,DA,0)),U,23)

 ..S ABMRV(ABMPO,ABMPO,ABMPO)=$G(ABMRV(ABM(5),ABM(7),ABMLCNT))

 ..K ABMRV(ABM(5),ABM(7),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

47 ;EP - Ambulance Services

 S DA=0

 F  S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA)) Q:'DA  D

 .F J=1:1:9 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,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)  ;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(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"),47,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"),47,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"),47,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"),47,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"),47,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

ABMERGR3  ; IHS/SD/SDR - GET ANCILLARY SVCS REVENUE CODE INFO ; 

 +1       ;;2.6;IHS Third Party Billing;**1,3,6,8,9,14,21,23**;NOV 12, 2009;Build 427

 +2       ;Original;DMJ;03/20/96 9:07 AM

 +3       ;

 +4       ;IHS/SD/SDR v2.5 p9 - split routine for size

 +5       ;IHS/SD/SDR v2.5 p10 - IM20395 - Split out lines bundled by Rev code

 +6       ;IHS/SD/SDR v2.5 p10 - IM21539 - Made anes amt just use base charge

 +7       ;IHS/SD/SDR v2.5 p12 - IM24093 - Put description in array if J-code

 +8       ;

 +9       ;IHS/SD/SDR v2.6 CSV

 +10      ;IHS/SD/SDR 2.6*1 HEAT6566 - Populate anes based on MCR/non-MCR

 +11      ;IHS/SD/SDR 2.6*3 HEAT12742 - Correction to MCR/non-MCR; removed all HEAT6566 changes

 +12      ;IHS/SD/SDR 2.6*6 5010 - added 5010 prompts to 43 multiple

 +13      ;IHS/SD/SDR 2.6*21 HEAT106899 - Get operating and rendering provider for 43 mult.

 +14      ;IHS/SD/SDR 2.6*21 HEAT120880 Added code for SERVICE DATE TO in ABMRV array for all multiples.

 +15      ;IHS/SD/AML 2.6*23 HEAT247169 For 43 subfile add NDC to array

 +16      ;IHS/SD/SDR 2.6*23 HEAT347035 Changed subscripts if there is a print order to be used

 +17      ;

37        ;EP - Laboratory

 +1        SET DA=0

 +2        FOR 

               SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA))

               IF 'DA

                   QUIT 

               Begin DoDot:1

 +3                FOR J=1:1:8

                       SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,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(6)

 +10      ;2nd modifier

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=ABM(7)

 +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(5)

 +15      ;3rd Modifier

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(8)

 +16      ;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"),37,DA,0)),U,12)

 +17      ;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"),37,DA,2)),U)

 +18      ;abm*2.6*9 NARR

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,2)),U,2)

 +19      ;start new abm*2.6*23 IHS/SD/SDR HEAT347035

 +20               IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,23)'=0

                       Begin DoDot:2

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

 +22                       SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,23)

 +23                       SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(+ABM(2),ABM(1),ABMLCNT))

 +24                       KILL ABMRV(+ABM(2),ABM(1),ABMLCNT)

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

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

 +27      ;end new abm*2.6*23 IHS/SD/SDR HEAT347035

               End DoDot:1

 +28       QUIT 

39        ;EP - Anesthesia

 +1        SET DA=0

 +2        FOR 

               SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA))

               IF 'DA

                   QUIT 

               Begin DoDot:1

 +3                FOR J=1:1:6,11,14,19

                       SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,0),"^",J)

 +4       ; CPT Code  ;CSV-c

                   SET ABM(1)=$SELECT(ABM(1):$PIECE($$CPT^ABMCVAPI(ABM(1),ABMP("VDT")),U,2),1:0)

 +5                SET ABMLCNT=+$GET(ABMLCNT)+1

 +6       ;Revenue code IEN

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U)=ABM(2)

 +7       ;CPT code

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,2)=ABM(1)

 +8       ;Modifier

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,3)=ABM(6)

 +9       ;2nd Modifier

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,4)=ABM(14)

 +10      ;units

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,5)=1

 +11      ;charges  ;abm*2.6*1 HEAT6566

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(4)

 +12      ;I ($G(ABMP("ITYP"))'="R")!($G(ABMP("ITYPE"))'="R") S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(4)  ;charges  ;abm*2.6*1 HEAT6566  abm*2.6*3 HEAT12742

 +13      ;I ($G(ABMP("ITYP"))="R")!($G(ABMP("ITYPE"))="R") S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(4)  ;charges  ;abm*2.6*3 HEAT12742

 +14      ;I ($G(ABMP("ITYP"))="R")!($G(ABMP("ITYPE"))="R") S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(3)+ABM(4)  ;charges  ;abm*2.6*1 HEAT6566abm*2.6*3 HEAT12742

 +15      ;I ($G(ABMP("ITYP"))'="R")!($G(ABMP("ITYPE"))'="R") S $P(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,6)=ABM(3)+ABM(4)  ;charges  ;abm*2.6*3 HEAT12742

 +16      ;Date/time of service

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(5)

 +17      ;3rd Modifier

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(19)

 +18      ;Other Provider

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,18)=ABM(11)

 +19      ;abm*2.6*21 IHS/SD/SDR HEAT120880

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,27)=ABM(5)

 +20      ;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"),39,DA,2)),U)

 +21      ;abm*2.6*9 NARR

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,2)),U,2)

 +22      ;start new abm*2.6*23 IHS/SD/SDR HEAT347035

 +23               IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,0)),U,23)'=0

                       Begin DoDot:2

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

 +25                       SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,0)),U,23)

 +26                       SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(+ABM(2),ABM(1),ABMLCNT))

 +27                       KILL ABMRV(+ABM(2),ABM(1),ABMLCNT)

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

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

 +30      ;end new abm*2.6*23 IHS/SD/SDR HEAT347035

               End DoDot:1

 +31       QUIT 

 +32      ;

43        ;EP - Miscellaneous Services

 +1        SET DA=0

 +2        FOR 

               SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA))

               IF 'DA

                   QUIT 

               Begin DoDot:1

 +3                FOR J=1:1:9

                       SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,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      ;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      ;CSV-c

                   IF $EXTRACT($PIECE($$CPT^ABMCVAPI($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U),ABMP("VDT")),U,2),1)="J"

                       Begin DoDot:2

 +15      ;description for J-codes only ;CSV-c

                           SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$PIECE($$CPT^ABMCVAPI($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U),ABMP("VDT")),U,3)

                       End DoDot:2

 +16      ;NDC  ;abm*2.6*23 IHS/SD/SDR HEAT247169

                   IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,19)'=""

                       SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,19)_" "_$PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,9)

 +17      ;date/time

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(7)

 +18      ;3rd Modifier

                   SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(9)