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)
+19 ;start new code abm*2.6*6 5010
+20 ;QTY/LENGTH MEDICAL NECESSITY
IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,1))
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,33)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,1)
+21 ;MONETARY AMT/DME RENTAL PRICE
IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,2))
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,34)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,2)
+22 ;MONETARY AMT/DME PURCH. PRICE
IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,3))
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,35)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,3)
+23 ;FRQ CODE/RENTAL UNIT PRICE IND
IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,4))
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,36)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,4)
+24 ;immun. batch
IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,5))
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,37)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,5)
+25 ;end new code 5010
+26 ;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"),43,DA,2)),U)
+27 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,2)),U,2)
+28 ;start new abm*2.6*21 IHS/SD/SDR HEAT106899
+29 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","O"))
Begin DoDot:2
+30 SET ABMPIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","O",0))
+31 SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,16)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P",ABMPIEN,0),U)
End DoDot:2
+32 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","R"))
Begin DoDot:2
+33 SET ABMPIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","R",0))
+34 SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,18)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P",ABMPIEN,0),U)
End DoDot:2
+35 ;end new abm*2.6*21 IHS/SD/SDR HEAT106899
+36 ;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"),43,DA,0)),U,12)
+37 ;start new abm*2.6*23 IHS/SD/SDR HEAT347035
+38 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,23)'=0
Begin DoDot:2
+39 ;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
+40 SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,23)
+41 SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(+ABM(2),ABM(1),ABMLCNT))
+42 KILL ABMRV(+ABM(2),ABM(1),ABMLCNT)
+43 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
+44 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
+45 ;end new abm*2.6*23 IHS/SD/SDR HEAT347035
End DoDot:1
+46 QUIT
45 ;EP - Supplies
+1 SET DA=0
+2 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA))
IF 'DA
QUIT
Begin DoDot:1
+3 FOR J=1:1:7
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,0),"^",J)
+4 IF '+ABM(3)
SET ABM(3)=1
+5 IF ABM(5)=""
SET ABM(5)=270
+6 ;CSV-c
SET ABM(7)=$PIECE($$CPT^ABMCVAPI(+ABM(7),ABMP("VDT")),U,2)
+7 IF ABM(7)=""
SET ABM(7)=0
+8 SET ABMLCNT=+$GET(ABMLCNT)+1
+9 ;Revenue code
SET ABMRV(ABM(5),ABM(7),ABMLCNT)=ABM(5)
+10 ;CPT Code
SET $PIECE(ABMRV(ABM(5),ABM(7),ABMLCNT),U,2)=ABM(7)
+11 ;units
SET $PIECE(ABMRV(ABM(5),ABM(7),ABMLCNT),U,5)=ABM(3)
+12 ;charges
SET $PIECE(ABMRV(ABM(5),ABM(7),ABMLCNT),U,6)=(ABM(3)*ABM(4))
+13 SET $PIECE(ABMRV(ABM(5),ABM(7),ABMLCNT),U,10)=ABM(2)
+14 SET $PIECE(ABMRV(ABM(5),ABM(7),ABMLCNT),U,8)=ABM(4)
+15 ;abm*2.6*21 IHS/SD/SDR HEAT120880
SET $PIECE(ABMRV(+ABM(5),ABM(7),ABMLCNT),U,27)=ABM(2)
+16 ;abm*2.6*8 5010 line item control number
SET $PIECE(ABMRV(ABM(5),ABM(7),ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,2)),U)
+17 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(ABM(5),ABM(7),ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,2)),U,2)
+18 ;start new abm*2.6*23 IHS/SD/SDR HEAT347035
+19 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,0)),U,23)'=0
Begin DoDot:2
+20 ;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
+21 SET ABMPO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,0)),U,23)
+22 SET ABMRV(ABMPO,ABMPO,ABMPO)=$GET(ABMRV(ABM(5),ABM(7),ABMLCNT))
+23 KILL ABMRV(ABM(5),ABM(7),ABMLCNT)
+24 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
+25 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
+26 ;end new abm*2.6*23 IHS/SD/SDR HEAT347035
End DoDot:1
+27 QUIT
47 ;EP - Ambulance Services
+1 SET DA=0
+2 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA))
IF 'DA
QUIT
Begin DoDot:1
+3 FOR J=1:1:9
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,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 ;date/time
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,10)=ABM(7)
+15 ;3rd Modifier
SET $PIECE(ABMRV(+ABM(2),ABM(1),ABMLCNT),U,12)=ABM(9)
+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"),47,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"),47,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"),47,DA,2)),U,2)
+19 ;start new abm*2.6*23 IHS/SD/SDR HEAT347035
+20 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,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"),47,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
