ABMEHGR2 ; IHS/ASDST/DMJ - GET ANCILLARY SVCS REVENUE CODE INFO ;
;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,10,11,19,21**;NOV 12, 2009;Build 379
;Original;DMJ;03/20/96 9:07 AM
;
; IHS/SD/SDR 2.5 P2 - 5/9/02 - NOIS HQW-0302-100190 Modified to display 2nd and 3rd modifiers and units
; IHS/SD/SDR 2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
; IHS/SD/EFG 2.5 P8 - IM16385 - Calculate line total when more than 1 unit for 837D and 837P
; IHS/SD/SDR 2.5 p8 - task 6 - Added code for new ambulance multiple 47
; IHS/SD/SDR 2.5 p9 - task 1 - Use new service line provider multiple
; IHS/SD/SDR 2.5 p9 - split routine for size
; IHS/SD/SDR 2.5 p10 - IM20395 - Split lines bundled by Rev code
; IHS/SD/SDR 2.5 p10 - IM19843 Added code for SERVICE TO DATE/TIME, NOTE: Removed old code due to routine size
;
;IHS/SD/SDR 2.6 CSV
;IHS/SD/SDR 2.6*6 - 5010 - added date written to array for 23
;IHS/SD/SDR 2.6*6 - 5010 - added line item control number
;IHS/SD/SDR 2.6*6 - HEAT28973 - if 55 modifier present use '1' as the units to calculate charges
;IHS/SD/SDR 2.6*19 - HEAT180453 - Added code to include AREA OF ORAL CAVITY in ABMRV array for dental.
;IHS/SD/SDR 2.6*19 - HEAT173117 - Correction to CPT Narrative for 23 multiple.
;IHS/SD/SDR 2.6*21 HEAT151848 Added code to make DTP*471 print for Date Written whether the RX is the ptr or freetext field.
;IHS/SD/SDR 2.6*21 -HEAT168435 - Added code for pharmacy (23 mult) modifiers.
; *********************************************************************
;
; ABMRV(SECTION,#) piece 1=revenue code, 2=CPT code, 3=modifier
; 4=2nd modifier, 5=units, 6=total charges, 8=unit charge
; 9=description, 10=date/time,
; 11=corresponding dx, 12=3rd modifier, 13=rendering provider
; 14=days of supply, 15=ndc#, 16=dea#, 17=new/refill code
; 18=referring provider, 19=purchased service provider
; 20=supervising provider, 21=ordering provider, 22=4th modifier
; 23=dental tooth, 24=dental tooth surface, 25=POS, 26=TOS
; 27=service to date/time
;
21 ;EP - Med/Surg
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA)) Q:'DA D
.F J=1:1:13,19 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0),U,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(21,DA,ABMLCNT),U)=ABM(3) ;Revenue code IEN
.S $P(ABMRV(21,DA,ABMLCNT),U,2)=ABM(1) ;CPT code
.S $P(ABMRV(21,DA,ABMLCNT),U,3)=ABM(9) ;Modifier
.S $P(ABMRV(21,DA,ABMLCNT),U,4)=ABM(11) ;2nd Modifier
.S $P(ABMRV(21,DA,ABMLCNT),U,5)=ABM(13) ; counter
.S $P(ABMRV(21,DA,ABMLCNT),U,6)=(ABM(7)*ABM(13)) ;unit charges
.I (ABM(9)="55")!(ABM(11)="55")!(ABM(12)="55") S $P(ABMRV(21,DA,ABMLCNT),U,6)=(ABM(7)) ;IHS/SD/AML 2/15/2011 HEAT28973
.S $P(ABMRV(21,DA,ABMLCNT),U,10)=ABM(5) ;date/time
.S $P(ABMRV(21,DA,ABMLCNT),U,11)=ABM(4) ;corresponding dx
.S $P(ABMRV(21,DA,ABMLCNT),U,12)=ABM(12)
.S ABM(14)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","R",0)) ;rendering provider
.I +ABM(14)'=0 S $P(ABMRV(21,DA,ABMLCNT),U,13)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P",ABM(14),0)),U)
.S $P(ABMRV(21,DA,ABMLCNT),U,25)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0)),U,15)
.S $P(ABMRV(21,DA,ABMLCNT),U,26)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0)),U,16)
.S ABM(21)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","D",0)) ;ordering provider
.I +ABM(21)'=0 S $P(ABMRV(21,DA,ABMLCNT),U,21)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P",ABM(21),0)),U)
.S $P(ABMRV(21,DA,ABMLCNT),U,27)=$S($G(ABM(19))'="":ABM(19),1:ABM(5)) ;service to date/time
.S $P(ABMRV(21,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,2)),U) ;abm*2.6*6 5010 line item control number
.S $P(ABMRV(21,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,2)),U,2) ;abm*2.6*9 NARR
Q
;
23 ;EP - Pharmacy
;
; ABMRV(IEN to REVENUE CODE, Medication IEN)= IEN to REVENUE CODE ^
; ^ ^ ^ units ^ charges ^ ^ ^ NDC generic name
; date/time
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA)) Q:'DA D
.;F J=1:1:6,13,14,19,22,28 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),U,J) ;abm*2.6*6 5010
.;F J=1:1:6,13,14,19,22,24,25,28 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),U,J) ;abm*2.6*6 5010 ;abm*2.6*8 HEAT35661
.F J=1:1:6,13,14,19,22,24,25,28,29 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),U,J) ;abm*2.6*6 5010 ;abm*2.6*8 HEAT35661
.S:'+ABM(3) ABM(3)=1 ; default units = 1
.S ABMLCNT=+$G(ABMLCNT)+1
.S $P(ABMRV(23,DA,ABMLCNT),U)=ABM(2) ;revenue code IEN
.;S $P(ABMRV(23,DA,ABMLCNT),U,2)=$S(ABM(29):$P($$CPT^ABMCVAPI(ABM(29),ABMP("VDT")),U,2),1:0) ;CPT abm*2.6*8 HEAT35661 ;abm*2.6*9 HEAT63888
.S $P(ABMRV(23,DA,ABMLCNT),U,2)=$S(ABM(29):$P($$CPT^ABMCVAPI(ABM(29),ABMP("VDT")),U,2),ABMP("EXP")=32:"J3490",1:0) ;CPT abm*2.6*8 HEAT35661 ;abm*2.6*9 HEAT63888
.S $P(ABMRV(23,DA,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(23,DA,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(23,DA,ABMLCNT),U,5)=ABM(3) ;units
.S ABM(7)=ABM(3)*ABM(4)+ABM(5) ;units * units cost + dispense fee
.S ABM(7)=$J(ABM(7),1,2)
.S $P(ABMRV(23,DA,ABMLCNT),U,6)=ABM(7) ;charges
.;S $P(ABMRV(23,DA,ABMLCNT),U,9)=$P($G(^PSDRUG(ABM(1),2)),U,4)_" "_$P($G(^(0)),U) ;NDC generic name ;abm*2.6*11
.I ABM(24)'="" S $P(ABMRV(23,DA,ABMLCNT),U,9)=ABM(24)_" "_$P($G(^PSDRUG(ABM(1),0)),U) ;NDC generic name ;abm*2.6*11
.I ABM(24)="" S $P(ABMRV(23,DA,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
.S $P(ABMRV(23,DA,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(23,DA,ABMLCNT),U,13)=$S(ABM(6)'="":ABM(6),1:ABM(22)) ;prescription ;abm*2.6*9 HEAT63888
.;S $P(ABMRV(23,DA,ABMLCNT),U,13)=$S($G(ABM(6))'="":ABM(6),$G(ABM(22))'="":$$GET1^DIQ(52,ABM(22),".01","E"),1:"") ;prescription ;abm*2.6*9 HEAT63888 ;abm*2.6*10 HEAT78446
.S $P(ABMRV(23,DA,ABMLCNT),U,28)=$S($G(ABM(6))'="":ABM(6),$G(ABM(22))'="":$$GET1^DIQ(52,ABM(22),".01","E"),1:"") ;prescription ;abm*2.6*9 HEAT63888 ;abm*2.6*10 HEAT78446
.K ABMDA,ABM(52)
.S ABM(21)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,"P","C","D",0)) ;ordering provider
.I +$G(ABM(21))'=0 S $P(ABMRV(23,DA,ABMLCNT),U,21)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,"P",ABM(21),0)),U)
.;start new code abm*2.6*9 NOHEAT
.S ABM(22)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,"P","C","R",0)) ;rendering provider
.I +$G(ABM(22))'=0 S $P(ABMRV(23,DA,ABMLCNT),U,22)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,"P",ABM(22),0)),U)
.;end new code
.D:ABM(6)
..N DA S DA=$O(^PSRX("B",ABM(6),0))
..Q:'DA
..S ABMDA=DA
..S DIQ="ABM(",DIQ(0)="IE",DIC="^PSRX("
..S DR="4;8;27"
..D EN^DIQ1
.;start new code abm*2.6*8 HEAT35661
.S $P(ABMRV(23,DA,ABMLCNT),U,11)=ABM(13) ;corresponding dx
.S $P(ABMRV(23,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U) ;abm*2.6*6 5010 line item control number
.;end new code HEAT35661
.S $P(ABMRV(23,DA,ABMLCNT),U,32)=ABM(25) ;date written ;abm*2.6*6 5010 ;abm*2.6*21 IHS/SD/SDR HEAT151848
.S $P(ABMRV(23,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,3)),U,2) ;abm*2.6*9 NARR ;abm*2.6*19 IHS/SD/SDR HEAT173117
.Q:'$G(ABMDA)
.S $P(ABMRV(23,DA,ABMLCNT),U,14)=ABM(52,ABMDA,8,"E") ;days of supply
.;S $P(ABMRV(23,DA,ABMLCNT),U,15)=ABM(52,ABMDA,27,"E") ;ndc # ;abm*2.6*6
.S $P(ABMRV(23,DA,ABMLCNT),U,15)=ABM(24) ;ndc # ;abm*2.6*6
.S ABMDEA=$P($G(^VA(200,+$G(ABM(52,ABMDA,4,"I")),"PS")),U,2) ;dea #
.S $P(ABMRV(23,DA,ABMLCNT),U,16)=ABMDEA
.S $P(ABMRV(23,DA,ABMLCNT),U,10)=ABM(14)
.S $P(ABMRV(23,DA,ABMLCNT),U,17)=ABM(19)
.S $P(ABMRV(23,DA,ABMLCNT),U,11)=ABM(13) ;corresponding dx
.;S $P(ABMRV(23,DA,ABMLCNT),U,27)=$S($G(ABM(28))'="":ABM(28),1:ABM(5)) ;service date to ;abm*2.6*10 HEAT70933
.S $P(ABMRV(23,DA,ABMLCNT),U,27)=$S($G(ABM(28))'="":ABM(28),1:ABM(14)) ;service date to ;abm*2.6*10 HEAT70933
.;S $P(ABMRV(23,DA,ABMLCNT),U,32)=ABM(25) ;date written ;abm*2.6*6 5010 ;abm*2.6*21 IHS/SD/SDR HEAT151848
.S $P(ABMRV(23,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U) ;abm*2.6*6 5010 line item control number
.;S $P(ABMRV(23,DA,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
Q
;
25 ;EP - Revenue Code
;
; ABMVR(IEN,0) = IEN to REVENUE CODE ^ ^ ^ ^ Cumulative units ^
; Charges ^ ^ Unit charge
;
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA)) Q:'DA D
.F J=1:1:3,6,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(25,DA,ABMLCNT),U)=ABM(1) ;Revenue code IEN
.;S $P(ABMRV(25,DA,ABMLCNT),U,2)=ABM(7) ;abm*2.6*11 HEAT117086
.S $P(ABMRV(25,DA,ABMLCNT),U,2)=$P($$CPT^ABMCVAPI(ABM(7),ABMP("VDT")),U,2) ;abm*2.6*11 HEAT117086
.S $P(ABMRV(25,DA,ABMLCNT),U,5)=ABM(2) ;units
.S $P(ABMRV(25,DA,ABMLCNT),U,6)=(ABM(2)*ABM(3))+ABM(6) ;charges
.S $P(ABMRV(25,DA,ABMLCNT),U,8)=ABM(3) ;Unit charge
.S $P(ABMRV(25,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U) ;abm*2.6*8 5010 line item control number
I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,10),'$D(ABMRV(25,450,ABMLCNT)) D
.S ABMRV(25,450,ABMLCNT)=450
.S $P(ABMRV(25,450,ABMLCNT),U,5)=1
.S $P(ABMRV(25,450,ABMLCNT),U,6)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),8),U,10) ;emergency room surcharge
.S $P(ABMRV(25,450,ABMLCNT),U,8)=$P(ABMRV(25,450,ABMLCNT),U,6)
.S $P(ABMRV(25,450,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U) ;abm*2.6*6 5010 line item control number
.S $P(ABMRV(25,450,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
;
; ABMRV(IEN to REVENUE CODE, CPT CODE)= IEN to REVENUE CODE ^
; CPT Code ^ Modifier ^ cumulative units ^ units
; ^ cumulative charges
;
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA)) Q:'DA D
.F J=1:1:10,12 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0),U,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(27,DA,ABMLCNT),U)=ABM(2) ;Revenue code IEN
.S $P(ABMRV(27,DA,ABMLCNT),U,2)=ABM(1) ;CPT code
.S $P(ABMRV(27,DA,ABMLCNT),U,3)=ABM(5) ;Modifier
.S $P(ABMRV(27,DA,ABMLCNT),U,10)=ABM(7) ;charge date
.S $P(ABMRV(27,DA,ABMLCNT),U,4)=ABM(8) ;2nd modifier
.S $P(ABMRV(27,DA,ABMLCNT),U,5)=ABM(3) ;units
.S $P(ABMRV(27,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4)) ;charges
.S $P(ABMRV(27,DA,ABMLCNT),U,11)=ABM(6) ;corresponding dx
.S $P(ABMRV(27,DA,ABMLCNT),U,12)=ABM(9) ;3rd Modifier
.S ABM(13)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,"P","C","R",0))
.I +ABM(13)'=0 S $P(ABMRV(27,DA,ABMLCNT),U,13)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,"P",ABM(13),0)),U) ;rendering provider
.S ABM(21)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,"P","C","D",0))
.I +ABM(21)'=0 S $P(ABMRV(27,DA,ABMLCNT),U,21)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,"P",ABM(21),0)),U) ;ordering provider
.S $P(ABMRV(27,DA,ABMLCNT),U,25)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,15)
.S $P(ABMRV(27,DA,ABMLCNT),U,26)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,16)
.S $P(ABMRV(27,DA,ABMLCNT),U,27)=$S($G(ABM(12))'="":ABM(12),1:ABM(7)) ;service to date/time
.I ABM(1)=99231!(ABM(1)=99232)!(ABM(1)=99233) D
..Q:+ABM(3)'>1
..I '+ABM(7) S ABM(7)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
..S $P(ABMRV(27,DA,ABMLCNT),U,15)=$$FMADD^XLFDT(ABM(7),(ABM(3)-1))
.S $P(ABMRV(27,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,2)),U) ;abm*2.6*6 5010 line item control number
.S $P(ABMRV(27,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,2)),U,2) ;abm*2.6*9 NARR
S ABMDCPT=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),ABMP("VTYP"),0)),U,16)
Q:ABMDCPT=""
S ABMDCPT=$P($$CPT^ABMCVAPI(ABMDCPT,ABMP("VDT")),U,2) ;CSV-c
Q:ABMDCPT=""
S DA=DA+1
S $P(ABMRV(27,DA,ABMLCNT),U,2)=ABMDCPT
S $P(ABMRV(27,DA,ABMLCNT),U,5)=1
S $P(ABMRV(27,DA,ABMLCNT),U,6)=$$FLAT^ABMDUTL(ABMP("INS"),ABMP("VTYP"),ABMP("VDT"))
Q
;
33 ;EP - Dental
;
; ABMRV(IEN, Dental Code) = IEN to REVENUE CODE ^ Dental code ^ ^
; ^ Cumulative units ^ Cumulative charges ^ ^ ^
; ADA Description ^ Date of Service
;
S DA=0
F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA)) Q:'DA D
.;F J=1:1:9 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0),"^",J) ;abm*2.6*19 HEAT180453
.F J=1:1:11 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0),"^",J) ;abm*2.6*19 HEAT180453
.S:'+ABM(9) ABM(9)=1
.S ABM("DCODE")=$P(^AUTTADA(ABM(1),0),U) ; dental code
.S ABMDENP=$P($G(^ABMDREC(ABMP("INS"),0)),U,2)
.S:ABMDENP="" ABMDENP=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,11)
.S:ABMDENP="" ABMDENP=$P($G(^ABMDPARM(DUZ(2),1,3)),U,11)
.S:ABMDENP]"" ABM("DCODE")=ABMDENP_ABM("DCODE")
.S ABMLCNT=+$G(ABMLCNT)+1
.S $P(ABMRV(33,DA,ABMLCNT),U)=ABM(2) ;Revenue code IEN
.S $P(ABMRV(33,DA,ABMLCNT),U,2)=ABM("DCODE") ;Dental code
.S $P(ABMRV(33,DA,ABMLCNT),U,5)=ABM(9) ;units
.S $P(ABMRV(33,DA,ABMLCNT),U,6)=(ABM(8)*ABM(9)) ;charges
.S $P(ABMRV(33,DA,ABMLCNT),U,9)=$P(^AUTTADA(ABM(1),0),U,2) ;ADA Description
.S $P(ABMRV(33,DA,ABMLCNT),U,10)=ABM(7) ;Date of service
.S $P(ABMRV(33,DA,ABMLCNT),U,11)=ABM(4) ;corresponding dx
.S $P(ABMRV(33,DA,ABMLCNT),U,23)=ABM(5) ;tooth
.S $P(ABMRV(33,DA,ABMLCNT),U,24)=ABM(6) ;surface
.;start new code abm*2.6*8 5010 service line providers
.S ABM(13)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,"P","C","R",0))
.I +ABM(13)'=0 S $P(ABMRV(33,DA,ABMLCNT),U,13)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,"P",ABM(13),0)),U) ;rendering provider
.S ABM(21)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,"P","C","S",0))
.I +ABM(21)'=0 S $P(ABMRV(33,DA,ABMLCNT),U,21)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,"P",ABM(21),0)),U) ;supervising provider
.;end new code abm*2.6*8
.S $P(ABMRV(33,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,2)),U) ;abm*2.6*6 5010 line item control number
.S $P(ABMRV(33,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,2)),U,2) ;abm*2.6*9 NARR
.S $P(ABMRV(33,DA,ABMLCNT),U,40)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0)),U,11) ;area of oral cavity ;abm*2.6*19 HEAT180453
Q
;
35 ;EP - Radiology
D 35^ABMEHGR3
Q
;
37 ;EP - Laboratory
D 37^ABMEHGR3
Q
;
39 ;EP - Anesthesia
D 39^ABMEHGR3
Q
;
43 ;EP - Miscellaneous Services
D 43^ABMEHGR3
Q
45 ;EP - Supplies
D 45^ABMEHGR3
Q
47 ;EP - Ambulance Services
D 47^ABMEHGR3
Q
ABMEHGR2 ; IHS/ASDST/DMJ - GET ANCILLARY SVCS REVENUE CODE INFO ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,10,11,19,21**;NOV 12, 2009;Build 379
+2 ;Original;DMJ;03/20/96 9:07 AM
+3 ;
+4 ; IHS/SD/SDR 2.5 P2 - 5/9/02 - NOIS HQW-0302-100190 Modified to display 2nd and 3rd modifiers and units
+5 ; IHS/SD/SDR 2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
+6 ; IHS/SD/EFG 2.5 P8 - IM16385 - Calculate line total when more than 1 unit for 837D and 837P
+7 ; IHS/SD/SDR 2.5 p8 - task 6 - Added code for new ambulance multiple 47
+8 ; IHS/SD/SDR 2.5 p9 - task 1 - Use new service line provider multiple
+9 ; IHS/SD/SDR 2.5 p9 - split routine for size
+10 ; IHS/SD/SDR 2.5 p10 - IM20395 - Split lines bundled by Rev code
+11 ; IHS/SD/SDR 2.5 p10 - IM19843 Added code for SERVICE TO DATE/TIME, NOTE: Removed old code due to routine size
+12 ;
+13 ;IHS/SD/SDR 2.6 CSV
+14 ;IHS/SD/SDR 2.6*6 - 5010 - added date written to array for 23
+15 ;IHS/SD/SDR 2.6*6 - 5010 - added line item control number
+16 ;IHS/SD/SDR 2.6*6 - HEAT28973 - if 55 modifier present use '1' as the units to calculate charges
+17 ;IHS/SD/SDR 2.6*19 - HEAT180453 - Added code to include AREA OF ORAL CAVITY in ABMRV array for dental.
+18 ;IHS/SD/SDR 2.6*19 - HEAT173117 - Correction to CPT Narrative for 23 multiple.
+19 ;IHS/SD/SDR 2.6*21 HEAT151848 Added code to make DTP*471 print for Date Written whether the RX is the ptr or freetext field.
+20 ;IHS/SD/SDR 2.6*21 -HEAT168435 - Added code for pharmacy (23 mult) modifiers.
+21 ; *********************************************************************
+22 ;
+23 ; ABMRV(SECTION,#) piece 1=revenue code, 2=CPT code, 3=modifier
+24 ; 4=2nd modifier, 5=units, 6=total charges, 8=unit charge
+25 ; 9=description, 10=date/time,
+26 ; 11=corresponding dx, 12=3rd modifier, 13=rendering provider
+27 ; 14=days of supply, 15=ndc#, 16=dea#, 17=new/refill code
+28 ; 18=referring provider, 19=purchased service provider
+29 ; 20=supervising provider, 21=ordering provider, 22=4th modifier
+30 ; 23=dental tooth, 24=dental tooth surface, 25=POS, 26=TOS
+31 ; 27=service to date/time
+32 ;
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:1:13,19
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0),U,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(21,DA,ABMLCNT),U)=ABM(3)
+7 ;CPT code
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,2)=ABM(1)
+8 ;Modifier
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,3)=ABM(9)
+9 ;2nd Modifier
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,4)=ABM(11)
+10 ; counter
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,5)=ABM(13)
+11 ;unit charges
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,6)=(ABM(7)*ABM(13))
+12 ;IHS/SD/AML 2/15/2011 HEAT28973
IF (ABM(9)="55")!(ABM(11)="55")!(ABM(12)="55")
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,6)=(ABM(7))
+13 ;date/time
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,10)=ABM(5)
+14 ;corresponding dx
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,11)=ABM(4)
+15 SET $PIECE(ABMRV(21,DA,ABMLCNT),U,12)=ABM(12)
+16 ;rendering provider
SET ABM(14)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","R",0))
+17 IF +ABM(14)'=0
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,13)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P",ABM(14),0)),U)
+18 SET $PIECE(ABMRV(21,DA,ABMLCNT),U,25)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0)),U,15)
+19 SET $PIECE(ABMRV(21,DA,ABMLCNT),U,26)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,0)),U,16)
+20 ;ordering provider
SET ABM(21)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P","C","D",0))
+21 IF +ABM(21)'=0
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,21)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,"P",ABM(21),0)),U)
+22 ;service to date/time
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,27)=$SELECT($GET(ABM(19))'="":ABM(19),1:ABM(5))
+23 ;abm*2.6*6 5010 line item control number
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,2)),U)
+24 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(21,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,DA,2)),U,2)
End DoDot:1
+25 QUIT
+26 ;
23 ;EP - Pharmacy
+1 ;
+2 ; ABMRV(IEN to REVENUE CODE, Medication IEN)= IEN to REVENUE CODE ^
+3 ; ^ ^ ^ units ^ charges ^ ^ ^ NDC generic name
+4 ; date/time
+5 SET DA=0
+6 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA))
IF 'DA
QUIT
Begin DoDot:1
+7 ;F J=1:1:6,13,14,19,22,28 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),U,J) ;abm*2.6*6 5010
+8 ;F J=1:1:6,13,14,19,22,24,25,28 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),U,J) ;abm*2.6*6 5010 ;abm*2.6*8 HEAT35661
+9 ;abm*2.6*6 5010 ;abm*2.6*8 HEAT35661
FOR J=1:1:6,13,14,19,22,24,25,28,29
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,0),U,J)
+10 ; default units = 1
IF '+ABM(3)
SET ABM(3)=1
+11 SET ABMLCNT=+$GET(ABMLCNT)+1
+12 ;revenue code IEN
SET $PIECE(ABMRV(23,DA,ABMLCNT),U)=ABM(2)
+13 ;S $P(ABMRV(23,DA,ABMLCNT),U,2)=$S(ABM(29):$P($$CPT^ABMCVAPI(ABM(29),ABMP("VDT")),U,2),1:0) ;CPT abm*2.6*8 HEAT35661 ;abm*2.6*9 HEAT63888
+14 ;CPT abm*2.6*8 HEAT35661 ;abm*2.6*9 HEAT63888
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,2)=$SELECT(ABM(29):$PIECE($$CPT^ABMCVAPI(ABM(29),ABMP("VDT")),U,2),ABMP("EXP")=32:"J3490",1:0)
+15 ;modifier ;abm*2.6*21 IHS/SD/SDR HEAT168435
SET $PIECE(ABMRV(23,DA,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(23,DA,ABMLCNT),U,4)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,4)
+17 ;units
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,5)=ABM(3)
+18 ;units * units cost + dispense fee
SET ABM(7)=ABM(3)*ABM(4)+ABM(5)
+19 SET ABM(7)=$JUSTIFY(ABM(7),1,2)
+20 ;charges
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,6)=ABM(7)
+21 ;S $P(ABMRV(23,DA,ABMLCNT),U,9)=$P($G(^PSDRUG(ABM(1),2)),U,4)_" "_$P($G(^(0)),U) ;NDC generic name ;abm*2.6*11
+22 ;NDC generic name ;abm*2.6*11
IF ABM(24)'=""
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,9)=ABM(24)_" "_$PIECE($GET(^PSDRUG(ABM(1),0)),U)
+23 ;NDC generic name ;abm*2.6*11
IF ABM(24)=""
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,9)=$PIECE($GET(^PSDRUG(ABM(1),2)),U,4)_" "_$PIECE($GET(^PSDRUG(ABM(1),0)),U)
+24 ;3rd modifier ;abm*2.6*21 IHS/SD/SDR HEAT168435
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,12)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U,5)
+25 ;S $P(ABMRV(23,DA,ABMLCNT),U,13)=$S(ABM(6)'="":ABM(6),1:ABM(22)) ;prescription ;abm*2.6*9 HEAT63888
+26 ;S $P(ABMRV(23,DA,ABMLCNT),U,13)=$S($G(ABM(6))'="":ABM(6),$G(ABM(22))'="":$$GET1^DIQ(52,ABM(22),".01","E"),1:"") ;prescription ;abm*2.6*9 HEAT63888 ;abm*2.6*10 HEAT78446
+27 ;prescription ;abm*2.6*9 HEAT63888 ;abm*2.6*10 HEAT78446
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,28)=$SELECT($GET(ABM(6))'="":ABM(6),$GET(ABM(22))'="":$$GET1^DIQ(52,ABM(22),".01","E"),1:"")
+28 KILL ABMDA,ABM(52)
+29 ;ordering provider
SET ABM(21)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,"P","C","D",0))
+30 IF +$GET(ABM(21))'=0
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,21)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,"P",ABM(21),0)),U)
+31 ;start new code abm*2.6*9 NOHEAT
+32 ;rendering provider
SET ABM(22)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,"P","C","R",0))
+33 IF +$GET(ABM(22))'=0
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,22)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,"P",ABM(22),0)),U)
+34 ;end new code
+35 IF ABM(6)
Begin DoDot:2
+36 NEW DA
SET DA=$ORDER(^PSRX("B",ABM(6),0))
+37 IF 'DA
QUIT
+38 SET ABMDA=DA
+39 SET DIQ="ABM("
SET DIQ(0)="IE"
SET DIC="^PSRX("
+40 SET DR="4;8;27"
+41 DO EN^DIQ1
End DoDot:2
+42 ;start new code abm*2.6*8 HEAT35661
+43 ;corresponding dx
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,11)=ABM(13)
+44 ;abm*2.6*6 5010 line item control number
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U)
+45 ;end new code HEAT35661
+46 ;date written ;abm*2.6*6 5010 ;abm*2.6*21 IHS/SD/SDR HEAT151848
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,32)=ABM(25)
+47 ;abm*2.6*9 NARR ;abm*2.6*19 IHS/SD/SDR HEAT173117
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,3)),U,2)
+48 IF '$GET(ABMDA)
QUIT
+49 ;days of supply
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,14)=ABM(52,ABMDA,8,"E")
+50 ;S $P(ABMRV(23,DA,ABMLCNT),U,15)=ABM(52,ABMDA,27,"E") ;ndc # ;abm*2.6*6
+51 ;ndc # ;abm*2.6*6
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,15)=ABM(24)
+52 ;dea #
SET ABMDEA=$PIECE($GET(^VA(200,+$GET(ABM(52,ABMDA,4,"I")),"PS")),U,2)
+53 SET $PIECE(ABMRV(23,DA,ABMLCNT),U,16)=ABMDEA
+54 SET $PIECE(ABMRV(23,DA,ABMLCNT),U,10)=ABM(14)
+55 SET $PIECE(ABMRV(23,DA,ABMLCNT),U,17)=ABM(19)
+56 ;corresponding dx
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,11)=ABM(13)
+57 ;S $P(ABMRV(23,DA,ABMLCNT),U,27)=$S($G(ABM(28))'="":ABM(28),1:ABM(5)) ;service date to ;abm*2.6*10 HEAT70933
+58 ;service date to ;abm*2.6*10 HEAT70933
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,27)=$SELECT($GET(ABM(28))'="":ABM(28),1:ABM(14))
+59 ;S $P(ABMRV(23,DA,ABMLCNT),U,32)=ABM(25) ;date written ;abm*2.6*6 5010 ;abm*2.6*21 IHS/SD/SDR HEAT151848
+60 ;abm*2.6*6 5010 line item control number
SET $PIECE(ABMRV(23,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),23,DA,2)),U)
+61 ;S $P(ABMRV(23,DA,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
End DoDot:1
+62 QUIT
+63 ;
25 ;EP - Revenue Code
+1 ;
+2 ; ABMVR(IEN,0) = IEN to REVENUE CODE ^ ^ ^ ^ Cumulative units ^
+3 ; Charges ^ ^ Unit charge
+4 ;
+5 SET DA=0
+6 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA))
IF 'DA
QUIT
Begin DoDot:1
+7 FOR J=1:1:3,6,7
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,0),"^",J)
+8 ; Default units = 1
IF '+ABM(2)
SET ABM(2)=1
+9 SET ABMLCNT=+$GET(ABMLCNT)+1
+10 ;Revenue code IEN
SET $PIECE(ABMRV(25,DA,ABMLCNT),U)=ABM(1)
+11 ;S $P(ABMRV(25,DA,ABMLCNT),U,2)=ABM(7) ;abm*2.6*11 HEAT117086
+12 ;abm*2.6*11 HEAT117086
SET $PIECE(ABMRV(25,DA,ABMLCNT),U,2)=$PIECE($$CPT^ABMCVAPI(ABM(7),ABMP("VDT")),U,2)
+13 ;units
SET $PIECE(ABMRV(25,DA,ABMLCNT),U,5)=ABM(2)
+14 ;charges
SET $PIECE(ABMRV(25,DA,ABMLCNT),U,6)=(ABM(2)*ABM(3))+ABM(6)
+15 ;Unit charge
SET $PIECE(ABMRV(25,DA,ABMLCNT),U,8)=ABM(3)
+16 ;abm*2.6*8 5010 line item control number
SET $PIECE(ABMRV(25,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U)
End DoDot:1
+17 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,10)
IF '$DATA(ABMRV(25,450,ABMLCNT))
Begin DoDot:1
+18 SET ABMRV(25,450,ABMLCNT)=450
+19 SET $PIECE(ABMRV(25,450,ABMLCNT),U,5)=1
+20 ;emergency room surcharge
SET $PIECE(ABMRV(25,450,ABMLCNT),U,6)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),8),U,10)
+21 SET $PIECE(ABMRV(25,450,ABMLCNT),U,8)=$PIECE(ABMRV(25,450,ABMLCNT),U,6)
+22 ;abm*2.6*6 5010 line item control number
SET $PIECE(ABMRV(25,450,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U)
+23 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(25,450,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),25,DA,2)),U,2)
End DoDot:1
+24 QUIT
+25 ;
27 ;EP - Medical Procedures
+1 ;
+2 ; ABMRV(IEN to REVENUE CODE, CPT CODE)= IEN to REVENUE CODE ^
+3 ; CPT Code ^ Modifier ^ cumulative units ^ units
+4 ; ^ cumulative charges
+5 ;
+6 SET DA=0
+7 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA))
IF 'DA
QUIT
Begin DoDot:1
+8 FOR J=1:1:10,12
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0),U,J)
+9 IF '+ABM(3)
SET ABM(3)=1
+10 ; CPT Code ;CSV-c
SET ABM(1)=$SELECT(ABM(1):$PIECE($$CPT^ABMCVAPI(ABM(1),ABMP("VDT")),U,2),1:0)
+11 SET ABMLCNT=+$GET(ABMLCNT)+1
+12 ;Revenue code IEN
SET $PIECE(ABMRV(27,DA,ABMLCNT),U)=ABM(2)
+13 ;CPT code
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,2)=ABM(1)
+14 ;Modifier
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,3)=ABM(5)
+15 ;charge date
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,10)=ABM(7)
+16 ;2nd modifier
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,4)=ABM(8)
+17 ;units
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,5)=ABM(3)
+18 ;charges
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4))
+19 ;corresponding dx
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,11)=ABM(6)
+20 ;3rd Modifier
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,12)=ABM(9)
+21 SET ABM(13)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,"P","C","R",0))
+22 ;rendering provider
IF +ABM(13)'=0
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,13)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,"P",ABM(13),0)),U)
+23 SET ABM(21)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,"P","C","D",0))
+24 ;ordering provider
IF +ABM(21)'=0
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,21)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,"P",ABM(21),0)),U)
+25 SET $PIECE(ABMRV(27,DA,ABMLCNT),U,25)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,15)
+26 SET $PIECE(ABMRV(27,DA,ABMLCNT),U,26)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,0)),U,16)
+27 ;service to date/time
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,27)=$SELECT($GET(ABM(12))'="":ABM(12),1:ABM(7))
+28 IF ABM(1)=99231!(ABM(1)=99232)!(ABM(1)=99233)
Begin DoDot:2
+29 IF +ABM(3)'>1
QUIT
+30 IF '+ABM(7)
SET ABM(7)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
+31 SET $PIECE(ABMRV(27,DA,ABMLCNT),U,15)=$$FMADD^XLFDT(ABM(7),(ABM(3)-1))
End DoDot:2
+32 ;abm*2.6*6 5010 line item control number
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,2)),U)
+33 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(27,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,DA,2)),U,2)
End DoDot:1
+34 SET ABMDCPT=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),ABMP("VTYP"),0)),U,16)
+35 IF ABMDCPT=""
QUIT
+36 ;CSV-c
SET ABMDCPT=$PIECE($$CPT^ABMCVAPI(ABMDCPT,ABMP("VDT")),U,2)
+37 IF ABMDCPT=""
QUIT
+38 SET DA=DA+1
+39 SET $PIECE(ABMRV(27,DA,ABMLCNT),U,2)=ABMDCPT
+40 SET $PIECE(ABMRV(27,DA,ABMLCNT),U,5)=1
+41 SET $PIECE(ABMRV(27,DA,ABMLCNT),U,6)=$$FLAT^ABMDUTL(ABMP("INS"),ABMP("VTYP"),ABMP("VDT"))
+42 QUIT
+43 ;
33 ;EP - Dental
+1 ;
+2 ; ABMRV(IEN, Dental Code) = IEN to REVENUE CODE ^ Dental code ^ ^
+3 ; ^ Cumulative units ^ Cumulative charges ^ ^ ^
+4 ; ADA Description ^ Date of Service
+5 ;
+6 SET DA=0
+7 FOR
SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA))
IF 'DA
QUIT
Begin DoDot:1
+8 ;F J=1:1:9 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0),"^",J) ;abm*2.6*19 HEAT180453
+9 ;abm*2.6*19 HEAT180453
FOR J=1:1:11
SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0),"^",J)
+10 IF '+ABM(9)
SET ABM(9)=1
+11 ; dental code
SET ABM("DCODE")=$PIECE(^AUTTADA(ABM(1),0),U)
+12 SET ABMDENP=$PIECE($GET(^ABMDREC(ABMP("INS"),0)),U,2)
+13 IF ABMDENP=""
SET ABMDENP=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,11)
+14 IF ABMDENP=""
SET ABMDENP=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),U,11)
+15 IF ABMDENP]""
SET ABM("DCODE")=ABMDENP_ABM("DCODE")
+16 SET ABMLCNT=+$GET(ABMLCNT)+1
+17 ;Revenue code IEN
SET $PIECE(ABMRV(33,DA,ABMLCNT),U)=ABM(2)
+18 ;Dental code
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,2)=ABM("DCODE")
+19 ;units
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,5)=ABM(9)
+20 ;charges
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,6)=(ABM(8)*ABM(9))
+21 ;ADA Description
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,9)=$PIECE(^AUTTADA(ABM(1),0),U,2)
+22 ;Date of service
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,10)=ABM(7)
+23 ;corresponding dx
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,11)=ABM(4)
+24 ;tooth
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,23)=ABM(5)
+25 ;surface
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,24)=ABM(6)
+26 ;start new code abm*2.6*8 5010 service line providers
+27 SET ABM(13)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,"P","C","R",0))
+28 ;rendering provider
IF +ABM(13)'=0
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,13)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,"P",ABM(13),0)),U)
+29 SET ABM(21)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,"P","C","S",0))
+30 ;supervising provider
IF +ABM(21)'=0
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,21)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,"P",ABM(21),0)),U)
+31 ;end new code abm*2.6*8
+32 ;abm*2.6*6 5010 line item control number
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,2)),U)
+33 ;abm*2.6*9 NARR
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,2)),U,2)
+34 ;area of oral cavity ;abm*2.6*19 HEAT180453
SET $PIECE(ABMRV(33,DA,ABMLCNT),U,40)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,DA,0)),U,11)
End DoDot:1
+35 QUIT
+36 ;
35 ;EP - Radiology
+1 DO 35^ABMEHGR3
+2 QUIT
+3 ;
37 ;EP - Laboratory
+1 DO 37^ABMEHGR3
+2 QUIT
+3 ;
39 ;EP - Anesthesia
+1 DO 39^ABMEHGR3
+2 QUIT
+3 ;
43 ;EP - Miscellaneous Services
+1 DO 43^ABMEHGR3
+2 QUIT
45 ;EP - Supplies
+1 DO 45^ABMEHGR3
+2 QUIT
47 ;EP - Ambulance Services
+1 DO 47^ABMEHGR3
+2 QUIT
