- ABMEHGR3 ; IHS/ASDST/DMJ - GET ANCILLARY SVCS REVENUE CODE INFO ;
- ;;2.6;IHS Third Party Billing;**1,3,6,9,23**;NOV 12, 2009;Build 427
- ;Original;DMJ;03/20/96 9:07 AM
- ;
- ;IHS/SD/SDR 2.5 p9 split routine from ABMEHGR2
- ;IHS/SD/SDR 2.5 p10 IM20395 Split lines bundled by rev code
- ;IHS/SD/SDR 2.5 p10 IM21539 Changed anes amt to just use base charge
- ;
- ;IHS/SD/SDR v2.6 CSV
- ;IHS/SD/SDR 2.6*1 HEAT6566 - populate anes based on MCR vs non-MCR
- ;IHS/SD/SDR 2.6*1 HEAT8498 - Use start/stop time, not service dates for anes
- ;IHS/SD/SDR 2.6*3 HEAT12742 - Correction to MCR/non-MCR; removed 6566 changes
- ;IHS/SD/SDR 2.6*6 5010 - added prompts for SV5 segment
- ;IHS/SD/SDR 2.6*6 5010 - added test date to 37 multiple
- ;IHS/SD/AML 2.6*23 HEAT247169 for subfile 43 add NDC to array of data
- ;
- 35 ;EP - Radiology
- S DA=0
- F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA)) Q:'DA D
- .F J=1:1:10,12 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,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(35,DA,ABMLCNT),U)=ABM(2) ;Revenue code IEN
- .S $P(ABMRV(35,DA,ABMLCNT),U,2)=ABM(1) ;CPT Code
- .S $P(ABMRV(35,DA,ABMLCNT),U,3)=ABM(5) ;Modifier
- .S $P(ABMRV(35,DA,ABMLCNT),U,4)=ABM(6) ;2nd Modifier
- .S $P(ABMRV(35,DA,ABMLCNT),U,5)=ABM(3) ;units
- .S $P(ABMRV(35,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4)) ;charges
- .S $P(ABMRV(35,DA,ABMLCNT),U,11)=ABM(8) ;corresponding dx
- .S $P(ABMRV(35,DA,ABMLCNT),U,12)=ABM(7) ;3rd Modifier
- .S $P(ABMRV(35,DA,ABMLCNT),U,10)=ABM(9) ;service date
- .S ABM(13)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,"P","C","R",0)) ;rendering provider
- .I +$G(ABM(13))'=0 S $P(ABMRV(35,DA,ABMLCNT),U,13)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,"P",ABM(13),0)),U)
- .S ABM(21)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,"P","C","D",0)) ;ordering provider
- .I +$G(ABM(21))'=0 S $P(ABMRV(35,DA,ABMLCNT),U,21)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,"P",ABM(21),0)),U)
- .S $P(ABMRV(35,DA,ABMLCNT),U,25)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,15)
- .S $P(ABMRV(35,DA,ABMLCNT),U,26)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,16)
- .S $P(ABMRV(35,DA,ABMLCNT),U,27)=$S($G(ABM(12))'="":ABM(12),1:ABM(9))
- .S $P(ABMRV(35,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,2)),U) ;abm*2.6*6 5010 line item control number
- .S $P(ABMRV(35,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,2)),U,2) ;abm*2.6*9 NARR
- Q
- 37 ;EP - Laboratory
- S DA=0
- F S DA=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA)) Q:'DA D
- .F J=1:1:9,12 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,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(37,DA,ABMLCNT),U)=ABM(2) ;Revenue code IEN
- .S $P(ABMRV(37,DA,ABMLCNT),U,2)=ABM(1) ;CPT Code
- .S $P(ABMRV(37,DA,ABMLCNT),U,3)=ABM(6) ;Modifier
- .S $P(ABMRV(37,DA,ABMLCNT),U,4)=ABM(7) ;2nd modifier
- .S $P(ABMRV(37,DA,ABMLCNT),U,5)=ABM(3) ;units
- .S $P(ABMRV(37,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4)) ;charges
- .S $P(ABMRV(37,DA,ABMLCNT),U,11)=ABM(9) ;corresponding dx
- .S $P(ABMRV(37,DA,ABMLCNT),U,12)=ABM(8) ;3rd Modifier
- .S ABM(13)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,"P","C","R",0)) ;rendering provider
- .I +$G(ABM(13))'=0 S $P(ABMRV(37,DA,ABMLCNT),U,14)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,"P",ABM(13),0)),U)
- .S ABM(21)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,"P","C","D",0)) ;ordering provider
- .I +$G(ABM(21))'=0 S $P(ABMRV(37,DA,ABMLCNT),U,21)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,"P",ABM(21),0)),U)
- .S $P(ABMRV(37,DA,ABMLCNT),U,25)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,15) ;HCFA POS
- .S $P(ABMRV(37,DA,ABMLCNT),U,26)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,16) ;HCFA TOS
- .S $P(ABMRV(37,DA,ABMLCNT),U,27)=$S($G(ABM(12))'="":ABM(12),1:ABM(5)) ;service to date/time
- .;S $P(ABMRV(37,DA,ABMLCNT),U,34)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,21) ;Test date ;abm*2.6*6 5010 ;abm*2.6*9 HEAT58663
- .S $P(ABMRV(37,DA,ABMLCNT),U,34)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,22) ;Test date ;abm*2.6*6 5010 ;abm*2.6*9 HEAT58663
- .S $P(ABMRV(37,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,2)),U) ;abm*2.6*6 5010 line item control number
- .S $P(ABMRV(37,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,2)),U,2) ;abm*2.6*9 NARR
- 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:10 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(39,DA,ABMLCNT),U)=ABM(2) ;Revenue code IEN
- .S $P(ABMRV(39,DA,ABMLCNT),U,2)=ABM(1) ;CPT code
- .S $P(ABMRV(39,DA,ABMLCNT),U,3)=ABM(6) ;Modifier
- .S $P(ABMRV(39,DA,ABMLCNT),U,5)=1 ;units
- .S $P(ABMRV(39,DA,ABMLCNT),U,6)=ABM(4) ;charges ;abm*2.6*1 HEAT6566
- .;I ($G(ABMP("ITYP"))'="R")!($G(ABMP("ITYPE"))'="R") S $P(ABMRV(39,DA,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(39,DA,ABMLCNT),U,6)=ABM(4) ;charges ;abm*2.6*3 HEAT12742
- .;I ($G(ABMP("ITYP"))="R")!($G(ABMP("ITYPE"))="R") S $P(ABMRV(39,DA,ABMLCNT),U,6)=ABM(3)+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(39,DA,ABMLCNT),U,6)=ABM(3)+ABM(4) ;charges ;abm*2.6*3 HEAT12742
- .;S $P(ABMRV(39,DA,ABMLCNT),U,10)=ABM(5) ;Date/time of service ;abm*2.6*1 HEAT8498
- .S $P(ABMRV(39,DA,ABMLCNT),U,10)=ABM(7) ;date/time from service date ;abm*2.6*1 HEAT8498
- .S $P(ABMRV(39,DA,ABMLCNT),U,11)=ABM(10) ;Corresponding DX
- .S ABM(13)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,"P","C","R",0)) ;rendering provider
- .I +$G(ABM(13))'=0 S $P(ABMRV(39,DA,ABMLCNT),U,13)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,"P",ABM(13),0)),U)
- .S ABM(21)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,"P","C","D",0)) ;ordering provider
- .I +$G(ABM(21))'=0 S $P(ABMRV(39,DA,ABMLCNT),U,21)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,"P",ABM(21),0)),U)
- .S $P(ABMRV(39,DA,ABMLCNT),U,25)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,0)),U,15)
- .S $P(ABMRV(39,DA,ABMLCNT),U,26)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,0)),U,16)
- .S $P(ABMRV(39,DA,ABMLCNT),U,27)=ABM(8) ;date/time to service date ;abm*2.6*1 HEAT8498
- .S ABMMTS=$$FMDIFF^XLFDT(ABM(8),ABM(7),2)
- .S ABMMTS=ABMMTS\60
- .S $P(ABMRV(39,DA,ABMLCNT),U,16)=ABMMTS
- .S $P(ABMRV(39,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,2)),U) ;abm*2.6*6 5010 line item control number
- .S $P(ABMRV(39,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,2)),U,2) ;abm*2.6*9 NARR
- .K ABMMTS
- 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,12 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,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(43,DA,ABMLCNT),U)=ABM(2) ;Revenue code IEN
- .S $P(ABMRV(43,DA,ABMLCNT),U,2)=ABM(1) ;CPT Code
- .S $P(ABMRV(43,DA,ABMLCNT),U,3)=ABM(5) ;Modifier
- .S $P(ABMRV(43,DA,ABMLCNT),U,4)=ABM(8) ;2nd Modifier
- .S $P(ABMRV(43,DA,ABMLCNT),U,5)=ABM(3) ;units
- .S $P(ABMRV(43,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4)) ;charges
- .S $P(ABMRV(43,DA,ABMLCNT),U,10)=ABM(7) ;Service from date/time
- .S $P(ABMRV(43,DA,ABMLCNT),U,11)=ABM(6) ;corresponding dx
- .S $P(ABMRV(43,DA,ABMLCNT),U,12)=ABM(9) ;3rd Modifier
- .S $P(ABMRV(43,DA,ABMLCNT),U,19)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,19) ;NDC ;abm*2.6*23 IHS/SD/AML HEAT247169
- .S ABM(13)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","R",0)) ;rendering provider
- .I +$G(ABM(13))'=0 S $P(ABMRV(43,DA,ABMLCNT),U,13)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P",ABM(13),0)),U)
- .S ABM(21)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","D",0)) ;ordering provider
- .I +$G(ABM(21))'=0 S $P(ABMRV(43,DA,ABMLCNT),U,21)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P",ABM(21),0)),U)
- .S $P(ABMRV(43,DA,ABMLCNT),U,25)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,15)
- .S $P(ABMRV(43,DA,ABMLCNT),U,26)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,16)
- .S $P(ABMRV(43,DA,ABMLCNT),U,27)=$S($G(ABM(12))'="":ABM(12),1:ABM(7)) ;service to date/time
- .;start new code abm*2.6*6 5010
- .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,1)) $P(ABMRV(43,DA,ABMLCNT),U,33)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,1)
- .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,2)) $P(ABMRV(43,DA,ABMLCNT),U,34)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,2)
- .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,3)) $P(ABMRV(43,DA,ABMLCNT),U,35)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,3)
- .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,4)) $P(ABMRV(43,DA,ABMLCNT),U,36)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,4)
- .S:+($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,5)) $P(ABMRV(43,DA,ABMLCNT),U,37)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,5) ;immun. batch#6
- .;end new code 5010
- .S $P(ABMRV(43,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,2)),U) ;abm*2.6*6 5010 line item control number
- .S $P(ABMRV(43,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,2)),U,2) ;abm*2.6*9 NARR
- 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(45,DA,ABMLCNT)=ABM(5) ;Revenue code
- .S $P(ABMRV(45,DA,ABMLCNT),U,2)=ABM(7) ;CPT Code
- .S $P(ABMRV(45,DA,ABMLCNT),U,5)=ABM(3) ;units
- .S $P(ABMRV(45,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4)) ;charges
- .S $P(ABMRV(45,DA,ABMLCNT),U,10)=ABM(2)
- .S $P(ABMRV(45,DA,ABMLCNT),U,8)=ABM(4)
- .S $P(ABMRV(45,DA,ABMLCNT),U,11)=ABM(6) ;corresponding dx
- .S $P(ABMRV(45,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,2)),U) ;abm*2.6*6 5010 line item control number
- .S $P(ABMRV(45,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,2)),U,2) ;abm*2.6*9 NARR
- 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,12 S ABM(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,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(47,DA,ABMLCNT),U)=ABM(2) ;Revenue code IEN
- .S $P(ABMRV(47,DA,ABMLCNT),U,2)=ABM(1) ;CPT Code
- .S $P(ABMRV(47,DA,ABMLCNT),U,3)=ABM(5) ;Modifier
- .S $P(ABMRV(47,DA,ABMLCNT),U,4)=ABM(8) ;2nd Modifier
- .S $P(ABMRV(47,DA,ABMLCNT),U,5)=ABM(3) ;units
- .S $P(ABMRV(47,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4)) ;charges
- .S $P(ABMRV(47,DA,ABMLCNT),U,11)=ABM(6) ;corresponding dx
- .S $P(ABMRV(47,DA,ABMLCNT),U,12)=ABM(9) ;3rd Modifier
- .S $P(ABMRV(47,DA,ABMLCNT),U,25)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA,0)),U,15)
- .S $P(ABMRV(47,DA,ABMLCNT),U,26)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA,0)),U,16)
- .S $P(ABMRV(47,DA,ABMLCNT),U,27)=$S($G(ABM(12))'="":ABM(12),1:ABM(7)) ;service to date/time
- .S $P(ABMRV(47,DA,ABMLCNT),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA,2)),U) ;abm*2.6*6 5010 line item control number
- .S $P(ABMRV(47,DA,ABMLCNT),U,39)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA,2)),U,2) ;abm*2.6*9 NARR
- Q
- ABMEHGR3 ; IHS/ASDST/DMJ - GET ANCILLARY SVCS REVENUE CODE INFO ;
- +1 ;;2.6;IHS Third Party Billing;**1,3,6,9,23**;NOV 12, 2009;Build 427
- +2 ;Original;DMJ;03/20/96 9:07 AM
- +3 ;
- +4 ;IHS/SD/SDR 2.5 p9 split routine from ABMEHGR2
- +5 ;IHS/SD/SDR 2.5 p10 IM20395 Split lines bundled by rev code
- +6 ;IHS/SD/SDR 2.5 p10 IM21539 Changed anes amt to just use base charge
- +7 ;
- +8 ;IHS/SD/SDR v2.6 CSV
- +9 ;IHS/SD/SDR 2.6*1 HEAT6566 - populate anes based on MCR vs non-MCR
- +10 ;IHS/SD/SDR 2.6*1 HEAT8498 - Use start/stop time, not service dates for anes
- +11 ;IHS/SD/SDR 2.6*3 HEAT12742 - Correction to MCR/non-MCR; removed 6566 changes
- +12 ;IHS/SD/SDR 2.6*6 5010 - added prompts for SV5 segment
- +13 ;IHS/SD/SDR 2.6*6 5010 - added test date to 37 multiple
- +14 ;IHS/SD/AML 2.6*23 HEAT247169 for subfile 43 add NDC to array of data
- +15 ;
- 35 ;EP - Radiology
- +1 SET DA=0
- +2 FOR
- SET DA=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA))
- IF 'DA
- QUIT
- Begin DoDot:1
- +3 FOR J=1:1:10,12
- SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,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(35,DA,ABMLCNT),U)=ABM(2)
- +8 ;CPT Code
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,2)=ABM(1)
- +9 ;Modifier
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,3)=ABM(5)
- +10 ;2nd Modifier
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,4)=ABM(6)
- +11 ;units
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,5)=ABM(3)
- +12 ;charges
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4))
- +13 ;corresponding dx
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,11)=ABM(8)
- +14 ;3rd Modifier
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,12)=ABM(7)
- +15 ;service date
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,10)=ABM(9)
- +16 ;rendering provider
- SET ABM(13)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,"P","C","R",0))
- +17 IF +$GET(ABM(13))'=0
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,13)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,"P",ABM(13),0)),U)
- +18 ;ordering provider
- SET ABM(21)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,"P","C","D",0))
- +19 IF +$GET(ABM(21))'=0
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,21)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,"P",ABM(21),0)),U)
- +20 SET $PIECE(ABMRV(35,DA,ABMLCNT),U,25)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,15)
- +21 SET $PIECE(ABMRV(35,DA,ABMLCNT),U,26)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,0)),U,16)
- +22 SET $PIECE(ABMRV(35,DA,ABMLCNT),U,27)=$SELECT($GET(ABM(12))'="":ABM(12),1:ABM(9))
- +23 ;abm*2.6*6 5010 line item control number
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,2)),U)
- +24 ;abm*2.6*9 NARR
- SET $PIECE(ABMRV(35,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),35,DA,2)),U,2)
- End DoDot:1
- +25 QUIT
- 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:9,12
- SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0),U,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(37,DA,ABMLCNT),U)=ABM(2)
- +8 ;CPT Code
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,2)=ABM(1)
- +9 ;Modifier
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,3)=ABM(6)
- +10 ;2nd modifier
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,4)=ABM(7)
- +11 ;units
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,5)=ABM(3)
- +12 ;charges
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4))
- +13 ;corresponding dx
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,11)=ABM(9)
- +14 ;3rd Modifier
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,12)=ABM(8)
- +15 ;rendering provider
- SET ABM(13)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,"P","C","R",0))
- +16 IF +$GET(ABM(13))'=0
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,14)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,"P",ABM(13),0)),U)
- +17 ;ordering provider
- SET ABM(21)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,"P","C","D",0))
- +18 IF +$GET(ABM(21))'=0
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,21)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,"P",ABM(21),0)),U)
- +19 ;HCFA POS
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,25)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,15)
- +20 ;HCFA TOS
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,26)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,16)
- +21 ;service to date/time
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,27)=$SELECT($GET(ABM(12))'="":ABM(12),1:ABM(5))
- +22 ;S $P(ABMRV(37,DA,ABMLCNT),U,34)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,21) ;Test date ;abm*2.6*6 5010 ;abm*2.6*9 HEAT58663
- +23 ;Test date ;abm*2.6*6 5010 ;abm*2.6*9 HEAT58663
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,34)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,0)),U,22)
- +24 ;abm*2.6*6 5010 line item control number
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,2)),U)
- +25 ;abm*2.6*9 NARR
- SET $PIECE(ABMRV(37,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,DA,2)),U,2)
- End DoDot:1
- +26 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:10
- 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(39,DA,ABMLCNT),U)=ABM(2)
- +7 ;CPT code
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,2)=ABM(1)
- +8 ;Modifier
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,3)=ABM(6)
- +9 ;units
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,5)=1
- +10 ;charges ;abm*2.6*1 HEAT6566
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,6)=ABM(4)
- +11 ;I ($G(ABMP("ITYP"))'="R")!($G(ABMP("ITYPE"))'="R") S $P(ABMRV(39,DA,ABMLCNT),U,6)=ABM(4) ;charges ;abm*2.6*1 HEAT6566 abm*2.6*3 HEAT12742
- +12 ;I ($G(ABMP("ITYP"))="R")!($G(ABMP("ITYPE"))="R") S $P(ABMRV(39,DA,ABMLCNT),U,6)=ABM(4) ;charges ;abm*2.6*3 HEAT12742
- +13 ;I ($G(ABMP("ITYP"))="R")!($G(ABMP("ITYPE"))="R") S $P(ABMRV(39,DA,ABMLCNT),U,6)=ABM(3)+ABM(4) ;charges ;abm*2.6*1 HEAT6566 abm*2.6*3 HEAT12742
- +14 ;I ($G(ABMP("ITYP"))'="R")!($G(ABMP("ITYPE"))'="R") S $P(ABMRV(39,DA,ABMLCNT),U,6)=ABM(3)+ABM(4) ;charges ;abm*2.6*3 HEAT12742
- +15 ;S $P(ABMRV(39,DA,ABMLCNT),U,10)=ABM(5) ;Date/time of service ;abm*2.6*1 HEAT8498
- +16 ;date/time from service date ;abm*2.6*1 HEAT8498
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,10)=ABM(7)
- +17 ;Corresponding DX
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,11)=ABM(10)
- +18 ;rendering provider
- SET ABM(13)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,"P","C","R",0))
- +19 IF +$GET(ABM(13))'=0
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,13)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,"P",ABM(13),0)),U)
- +20 ;ordering provider
- SET ABM(21)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,"P","C","D",0))
- +21 IF +$GET(ABM(21))'=0
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,21)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,"P",ABM(21),0)),U)
- +22 SET $PIECE(ABMRV(39,DA,ABMLCNT),U,25)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,0)),U,15)
- +23 SET $PIECE(ABMRV(39,DA,ABMLCNT),U,26)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,0)),U,16)
- +24 ;date/time to service date ;abm*2.6*1 HEAT8498
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,27)=ABM(8)
- +25 SET ABMMTS=$$FMDIFF^XLFDT(ABM(8),ABM(7),2)
- +26 SET ABMMTS=ABMMTS\60
- +27 SET $PIECE(ABMRV(39,DA,ABMLCNT),U,16)=ABMMTS
- +28 ;abm*2.6*6 5010 line item control number
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,2)),U)
- +29 ;abm*2.6*9 NARR
- SET $PIECE(ABMRV(39,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),39,DA,2)),U,2)
- +30 KILL ABMMTS
- 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,12
- SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0),U,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(43,DA,ABMLCNT),U)=ABM(2)
- +8 ;CPT Code
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,2)=ABM(1)
- +9 ;Modifier
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,3)=ABM(5)
- +10 ;2nd Modifier
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,4)=ABM(8)
- +11 ;units
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,5)=ABM(3)
- +12 ;charges
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4))
- +13 ;Service from date/time
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,10)=ABM(7)
- +14 ;corresponding dx
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,11)=ABM(6)
- +15 ;3rd Modifier
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,12)=ABM(9)
- +16 ;NDC ;abm*2.6*23 IHS/SD/AML HEAT247169
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,19)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,19)
- +17 ;rendering provider
- SET ABM(13)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","R",0))
- +18 IF +$GET(ABM(13))'=0
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,13)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P",ABM(13),0)),U)
- +19 ;ordering provider
- SET ABM(21)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P","C","D",0))
- +20 IF +$GET(ABM(21))'=0
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,21)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,"P",ABM(21),0)),U)
- +21 SET $PIECE(ABMRV(43,DA,ABMLCNT),U,25)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,15)
- +22 SET $PIECE(ABMRV(43,DA,ABMLCNT),U,26)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,0)),U,16)
- +23 ;service to date/time
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,27)=$SELECT($GET(ABM(12))'="":ABM(12),1:ABM(7))
- +24 ;start new code abm*2.6*6 5010
- +25 IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,1))
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,33)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,1)
- +26 IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,2))
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,34)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,2)
- +27 IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,3))
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,35)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,3)
- +28 IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,4))
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,36)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,4)
- +29 ;immun. batch#6
- IF +($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,5))
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,37)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,1)),U,5)
- +30 ;end new code 5010
- +31 ;abm*2.6*6 5010 line item control number
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,2)),U)
- +32 ;abm*2.6*9 NARR
- SET $PIECE(ABMRV(43,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,DA,2)),U,2)
- End DoDot:1
- +33 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(45,DA,ABMLCNT)=ABM(5)
- +10 ;CPT Code
- SET $PIECE(ABMRV(45,DA,ABMLCNT),U,2)=ABM(7)
- +11 ;units
- SET $PIECE(ABMRV(45,DA,ABMLCNT),U,5)=ABM(3)
- +12 ;charges
- SET $PIECE(ABMRV(45,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4))
- +13 SET $PIECE(ABMRV(45,DA,ABMLCNT),U,10)=ABM(2)
- +14 SET $PIECE(ABMRV(45,DA,ABMLCNT),U,8)=ABM(4)
- +15 ;corresponding dx
- SET $PIECE(ABMRV(45,DA,ABMLCNT),U,11)=ABM(6)
- +16 ;abm*2.6*6 5010 line item control number
- SET $PIECE(ABMRV(45,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,2)),U)
- +17 ;abm*2.6*9 NARR
- SET $PIECE(ABMRV(45,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,DA,2)),U,2)
- End DoDot:1
- +18 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,12
- SET ABM(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA,0),U,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(47,DA,ABMLCNT),U)=ABM(2)
- +8 ;CPT Code
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,2)=ABM(1)
- +9 ;Modifier
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,3)=ABM(5)
- +10 ;2nd Modifier
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,4)=ABM(8)
- +11 ;units
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,5)=ABM(3)
- +12 ;charges
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,6)=(ABM(3)*ABM(4))
- +13 ;corresponding dx
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,11)=ABM(6)
- +14 ;3rd Modifier
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,12)=ABM(9)
- +15 SET $PIECE(ABMRV(47,DA,ABMLCNT),U,25)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA,0)),U,15)
- +16 SET $PIECE(ABMRV(47,DA,ABMLCNT),U,26)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA,0)),U,16)
- +17 ;service to date/time
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,27)=$SELECT($GET(ABM(12))'="":ABM(12),1:ABM(7))
- +18 ;abm*2.6*6 5010 line item control number
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA,2)),U)
- +19 ;abm*2.6*9 NARR
- SET $PIECE(ABMRV(47,DA,ABMLCNT),U,39)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),47,DA,2)),U,2)
- End DoDot:1
- +20 QUIT