ABMERGRV ; IHS/SD/SDR - GET ANCILLARY SVCS REVENUE CODE INFO ;
;;2.6;IHS Third Party Billing;**1,8,11,13,20,21,22,23,25**;NOV 12, 2009;Build 444
;Original;DMJ;01/26/96 4:02 PM
; IHS/SD/SDR 2.5 p8 task 6 Added code for new ambulance multiple 47
; IHS/SD/SDR 2.5 p9 IM18857 Added code to print FL45
; IHS/SD/SDR 2.5 p10 IM20395 Split out lines bundled by rev code
; IHS/SD/SDR 2.5 p10 IM20396 Made change to fix covered days amount when there aren't any covered days
;
;IHS/SD/SDR 2.6 CSV
;IHS/SD/SDR 2.6*1 HEAT5691 Correction for covered days
;IHS/SD/SDR 2.6*1 HEAT6395 allow dental codes to print on UB
;IHS/SD/SDR 2.6*1 HEAT7884
;IHS/SD/SDR 2.6*13 HEAT135507 fix for <SUBSCR>P1+39^ABMERGRV
;IHS/SD/SDR 2.6*13 HEAT117086 Removed code to put T1015 as top line; it doesn't work here.
;IHS/SD/AML 2.6*20 HEAT262141 Made changes for AHCCCS RX billing
;IHS/SD/SDR 2.6*21 HEAT120880 Updated so flat rate will have service from and service to dates
;IHS/SD/SDR 2.6*22 HEAT335246 Made it so if the insurer is setup to print the NDC it will do flat rate and itemized on a claim, with either the default CPT
; printing with the flat rate or the flat rate printing on the first line item.
;IHS/SD/SDR 2.6*23 HEAT247169 Added code to check subfile 43 if visit type is 997.
;IHS/SD/SDR 2.6*23 HEAT347035 Added quit if print order was selected to not do the T1015-on-top thing
;IHS/SD/SDR 2.6*25 CR10016 Made change to fix Arizona Medicaid pharmacy billing rev code 519
;
; *********************************************************************
;
START ;START HERE
K ABM,ABMRV
D ORV
D P1
D FLP
Q
;
ORV ; EP
; OTHER REVENUE CODE
; ABMRV(IEN to REVENUE CODE,0) = IEN to REVENUE CODE ^ ^ ^ ^ 1 ^
; Revenue charge ^ ^ Revenue charge
I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",7) D
.S ABMRV(+$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),9),U,7),0,1)=$P(^(9),U,7)_"^^^^1^"_$P(^(9),U,8)_"^^"_$P(^(9),U,8)
Q
;
P1 ;EP - SET UP ABMRV ARRAY
; 21 - Med/Surg
; 23 - Pharmacy
; 25 - Room and Board
; 27 - Medical Procedures
; 33 - Dental
; 35 - Radiology
; 37 - Laboratory
; 39 - Anesthesia
; 43 - Miscellaneous Services
; 45 - Supplies
; 47 - Ambulance
;
; if not flat rate .....
;I '$D(ABMP("FLAT")) D ;abm*2.6*22 IHS/SD/SDR HEAT335246
I '$D(ABMP("FLAT"))!(($D(ABMP("FLAT")))&($P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")) D ;abm*2.6*22 IHS/SD/SDR HEAT335246
.N I
.F I=21,23,25,27,33,35,37,39,43,45,47 D
..; dont get pharmacy if RX bill status is unbillable
..I $P($G(^AUTNINS(ABMP("INS"),2)),"^",3)="U",I=23 Q
..;this will make only viewable pages in CE show on bill, not everything
..;I ABMP("VTYP")=998,((I'=21)&(I'=25)&(I'=27)&(I'=39)&(I'=45)&(I'=47)) Q ;dental ;abm*2.6*1 HEAT6395
..;I ABMP("VTYP")=997,(I'=23) Q ;pharmacy ;abm*2.6*23 IHS/SD/SDR HEAT247169
..I ABMP("VTYP")=997,((I'=23)&(I'=43)) Q ;pharmacy ;abm*2.6*23 IHS/SD/SDR HEAT247169
..I ABMP("VTYP")=996,(I'=37) Q ;lab
..I ABMP("VTYP")=995,(I'=35) Q ;rad
..I $G(ABMP("CLIN"))="A3",((I'=43)&(I'=47)) Q ;ambulance
..D @(I_"^ABMERGR2") ; get ancillary services revenue code info
;
;start new code abm*2.6*11 HEAT117086
;I ABMP("ITYPE")="D" D ;abm*2.6*13 HEAT135507
I (($P($G(^AUTNINS(ABMP("INS"),0)),U)="ARBOR HEALTH PLAN")!($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"))&($D(ABMRV)) D ;abm*2.6*21 IHS/SD/DR HEAT205579
.I +$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),"PO",0))'=0 Q ;the lines have been sequenced so don't do this ;abm*2.6*23 IHS/SD/SDR HEAT347035
.S ABMIS=$O(ABMRV(0))
.;S ABMJS=+$O(ABMRV(ABMIS,0)) ;abm*2.6*13 HEAT135507
.S ABMJS=$O(ABMRV(ABMIS,"")) ;abm*2.6*13 HEAT135507
.;S ABMKS=$O(ABMRV(ABMIS,ABMJS,0)) ;abm*2.6*13 HEAT135507
.S ABMKS=$O(ABMRV(ABMIS,ABMJS,"")) ;abm*2.6*13 HEAT135507
.S ABMI=0
.F S ABMI=$O(ABMRV(ABMI)) Q:'ABMI D
..S ABMJ=""
..F S ABMJ=$O(ABMRV(ABMI,ABMJ)) Q:$G(ABMJ)="" D
...;S ABMK=0 ;abm*2.6*13 HEAT135507
...S ABMK="" ;abm*2.6*13 HEAT135507
...F S ABMK=$O(ABMRV(ABMI,ABMJ,ABMK)) Q:'ABMK D
....I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,2)'="T1015" Q
....;start old abm*2.6*13 HEAT147327
....;S ABMTMP("TMP")=$G(ABMRV(ABMIS,ABMJS,ABMKS))
....;S ABMRV(ABMIS,ABMJS,ABMKS)=$G(ABMRV(ABMI,ABMJ,ABMK))
....;S ABMRV(ABMI,ABMJ,ABMK)=$G(ABMTMP("TMP"))
....;end old start new HEAT147327
....S ABMTMP("TMP")=$G(ABMRV(ABMIS,ABMJS,ABMKS))
....S ABMRV(ABMIS,ABMJS,ABMKS)=$G(ABMRV(ABMI,ABMJ,ABMK))
....S ABMRV(ABMI,ABMJ,ABMK)=$G(ABMTMP("TMP"))
....;end new HEAT147327
K ABMI,ABMJ,ABMK,ABMTMP
.;end new code HEAT117086
;
I $P($G(^DIC(40.7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)="A3" D
.S ABMODMOD=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,14)_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,16)
.S I=0
.F S I=$O(ABMRV(I)) Q:'I D
..S J=""
..S J=$O(ABMRV(I,J)) Q:J="" D
...S K=0
...F S K=$O(ABMRV(I,J,K)) Q:K="" D
....I $P(ABMRV(I,J,K),U,3)="QL" S ABMQLFLG=1
.S I=0
.F S I=$O(ABMRV(I)) Q:'I D
..S J=""
..F S J=$O(ABMRV(I,J)) Q:J="" D
...S K=0
...F S K=$O(ABMRV(I,J,K)) Q:K="" D
....I $G(ABMQLFLG)=1,($P(ABMRV(I,J,K),U,3)'="QL") S $P(ABMRV(I,J,K),U,3)=""
....I $G(ABMQLFLG)'=1 S $P(ABMRV(I,J,K),U,3)=$S($P(ABMRV(I,J,K),U,3)="":ABMODMOD,1:$P(ABMRV(I,J,K),U,3)_":"_ABMODMOD)
K ABMQLFLG
;
; if flat rate ....
I $D(ABMP("FLAT")) D
.N I
.F I=1:1:3 S ABM(I)=$P(ABMP("FLAT"),"^",I)
.I (ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID")) S ABM(3)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),5)),U,7) ;abm*2.6*1 HEAT7884
.S ABMRV(+ABM(2),0,1)=+ABM(2)_"^^^^"_ABM(3)_"^"_($S(+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)'=0:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U),1:ABM(1)*ABM(3)))_"^^"_ABM(1)
.;I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)'=0 S $P(ABMRV(+ABM(2),0,1),U,6)=(+$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,8))
.S $P(ABMRV(+ABM(2),0,1),U,10)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
.S $P(ABMRV(+ABM(2),0,1),U,27)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,2) ;service date to ;abm*2.6*21 IHS/SD/SDR HEAT120880
.S $P(ABMRV(+ABM(2),0,1),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U,9) ;abm*2.6*8 5010
.S ABMP("CDAYS")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,3) ;abm*2.6*1 HEAT5691
.I +$G(ABMP("CDAYS"))>0 D
..S $P(ABMRV(+ABM(2),0,1),U,5)=$G(ABMP("CDAYS"))
..S $P(ABMRV(+ABM(2),0,1),U,6)=$G(ABMP("CDAYS"))*ABM(1)
.S ABMCPT=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16) I ABMCPT D
..S ABMCPT=$P($$CPT^ABMCVAPI(ABMCPT,ABMP("VDT")),U,2) ;CSV-c
..S ABMP("CPT")=ABMCPT
..S $P(ABMRV(+ABM(2),0,1),U,2)=ABMCPT
..Q:$G(ABMP("EXP"))'=11
..S $P(ABMRV(+ABM(2),"TOT"),U,2)=ABMCPT
.S ABM(4)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U,6)
.I ABM(4),ABMP("VTYP")=111 S $P(ABMRV(+ABM(2),0,1),U,7)=(ABM(4)*ABM(1))
.I ABM(4),(+$G(ABMP("CDAYS"))=0) S $P(ABMRV(+ABM(2),0,1),U,5)=0
.;start new abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT
.I $$RCID^ABMERUTL(ABMP("INS"))=99999 D
..N I
..F I=23 D
...Q:(ABMP("VTYP")'=997) ;pharmacy
...K ABM
...D @(I_"^ABMERGR2") ; get ancillary services revenue code info
...;
...;For AZ Medicaid make all rev codes 519
...S A=0
...F S A=$O(ABMRV(A)) Q:'A D
....S B=-1
....F S B=$O(ABMRV(A,B)) Q:B="" D
.....S C=0
.....F S C=$O(ABMRV(A,B,C)) Q:'C D
......Q:A=519
......S ABMRV(519,B,C)=$G(ABMRV(A,B,C))
......K ABMRV(A,B,C)
...S A=$O(ABMRV(519,0))
...Q:+A=0
...S B=$O(ABMRV(519,A,0))
...;S $P(ABMRV(519,A,B),U,6)=$P(ABMRV(519,0,1),U,6) ;put flat rate on first drug line ;abm*2.6*25 IHS/SD/SDR CR10016
...S $P(ABMRV(519,A,B),U,6)=$P(ABMRV(519,0,1),U,6),$P(ABMRV(519,A,B),U)=519 ;put flat rate on first drug line and piece 1 as 519 ;abm*2.6*25 IHS/SD/SDR CR10016
...K ABMRV(519,0,1) ;remove flat rate line
...;start new abm*2.6*25 IHS/SD/SDR CR10016
...S B=0
...F S B=$O(ABMRV(519,B)) Q:'B D
....S C=0
....F S C=$O(ABMRV(519,B,C)) Q:'C D
.....S $P(ABMRV(519,B,C),U)=519
...K A,B,C
...;end new abm*2.6*25 IHS/SD/SDR CR10016
...;end new abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT
.;
.;start old code abm*2.6*11 HEAT105003
.;I ABMP("VTYP")=831 D
.;.K ABMRV(+ABM(2),0),ABM("831SET")
.;.N I
.;.F I=21,27,35 D @(I_"^ABMERGR2")
.;.S I=0
.;.F S I=$O(ABMRV(I)) Q:'I D
.;..N J
.;..S J=0
.;..F S J=$O(ABMRV(I,J)) Q:'J D
.;...S K=0
.;...F S K=$O(ABMRV(I,J,K)) Q:'K D
.;....S $P(ABMRV(I,J,K),U,6)=0
.;....S:'$G(ABM("831SET")) $P(ABMRV(I,J,K),U,6)=$P(ABMP("FLAT"),U),ABM("831SET")=1
.;end old code HEAT105003
K ABMCPT
Q
;
FLP ;FORMAT LOOP
F J=5,6,7 S ABM("TOT",J)=0
S I=0
F S I=$O(ABMRV(I)) Q:'I D
.D TOT
.F J=1:1:9 D FMT
.S ABMRV(I)=$TR(ABMRV(I),"^")
S ABMRV(9999)="001^^^^"_ABM("TOT",5)_"^"_ABM("TOT",6)_"^"_ABM("TOT",7)
S ABMRV(9999,0)=ABMRV(9999)
S I=9999
F J=1:1:9 D FMT
S ABMRV(9999)=$TR(ABMRV(9999),"^")
K ABM
Q
;
FMT ;Format
S ABM(J)=$P(ABMRV(I),"^",J)
I J>4&(J<8) S ABM("TOT",J)=ABM("TOT",J)+ABM(J)
S ABM("FSTR")=$P("4NR^5^2^2^7NR^10NRJ2^10NRJ2^4^12","^",J)
S ABM(J)=$$FMT^ABMERUTL(ABM(J),ABM("FSTR"))
S $P(ABMRV(I),"^",J)=ABM(J)
Q
;
TOT ;TOTAL TO REVENUE CODE
S J=-1
F S J=$O(ABMRV(I,J)) Q:J="" D
.S L=0
.F S L=$O(ABMRV(I,J,L)) Q:L="" D
..S $P(ABMRV(I),U,1)=I
..F K=2,3,4 S $P(ABMRV(I),U,K)=""
..F K=5,6,7 S $P(ABMRV(I),U,K)=$P(ABMRV(I),U,K)+$P(ABMRV(I,J,L),U,K)
Q
ABMERGRV ; IHS/SD/SDR - GET ANCILLARY SVCS REVENUE CODE INFO ;
+1 ;;2.6;IHS Third Party Billing;**1,8,11,13,20,21,22,23,25**;NOV 12, 2009;Build 444
+2 ;Original;DMJ;01/26/96 4:02 PM
+3 ; IHS/SD/SDR 2.5 p8 task 6 Added code for new ambulance multiple 47
+4 ; IHS/SD/SDR 2.5 p9 IM18857 Added code to print FL45
+5 ; IHS/SD/SDR 2.5 p10 IM20395 Split out lines bundled by rev code
+6 ; IHS/SD/SDR 2.5 p10 IM20396 Made change to fix covered days amount when there aren't any covered days
+7 ;
+8 ;IHS/SD/SDR 2.6 CSV
+9 ;IHS/SD/SDR 2.6*1 HEAT5691 Correction for covered days
+10 ;IHS/SD/SDR 2.6*1 HEAT6395 allow dental codes to print on UB
+11 ;IHS/SD/SDR 2.6*1 HEAT7884
+12 ;IHS/SD/SDR 2.6*13 HEAT135507 fix for <SUBSCR>P1+39^ABMERGRV
+13 ;IHS/SD/SDR 2.6*13 HEAT117086 Removed code to put T1015 as top line; it doesn't work here.
+14 ;IHS/SD/AML 2.6*20 HEAT262141 Made changes for AHCCCS RX billing
+15 ;IHS/SD/SDR 2.6*21 HEAT120880 Updated so flat rate will have service from and service to dates
+16 ;IHS/SD/SDR 2.6*22 HEAT335246 Made it so if the insurer is setup to print the NDC it will do flat rate and itemized on a claim, with either the default CPT
+17 ; printing with the flat rate or the flat rate printing on the first line item.
+18 ;IHS/SD/SDR 2.6*23 HEAT247169 Added code to check subfile 43 if visit type is 997.
+19 ;IHS/SD/SDR 2.6*23 HEAT347035 Added quit if print order was selected to not do the T1015-on-top thing
+20 ;IHS/SD/SDR 2.6*25 CR10016 Made change to fix Arizona Medicaid pharmacy billing rev code 519
+21 ;
+22 ; *********************************************************************
+23 ;
START ;START HERE
+1 KILL ABM,ABMRV
+2 DO ORV
+3 DO P1
+4 DO FLP
+5 QUIT
+6 ;
ORV ; EP
+1 ; OTHER REVENUE CODE
+2 ; ABMRV(IEN to REVENUE CODE,0) = IEN to REVENUE CODE ^ ^ ^ ^ 1 ^
+3 ; Revenue charge ^ ^ Revenue charge
+4 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",7)
Begin DoDot:1
+5 SET ABMRV(+$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),9),U,7),0,1)=$PIECE(^(9),U,7)_"^^^^1^"_$PIECE(^(9),U,8)_"^^"_$PIECE(^(9),U,8)
End DoDot:1
+6 QUIT
+7 ;
P1 ;EP - SET UP ABMRV ARRAY
+1 ; 21 - Med/Surg
+2 ; 23 - Pharmacy
+3 ; 25 - Room and Board
+4 ; 27 - Medical Procedures
+5 ; 33 - Dental
+6 ; 35 - Radiology
+7 ; 37 - Laboratory
+8 ; 39 - Anesthesia
+9 ; 43 - Miscellaneous Services
+10 ; 45 - Supplies
+11 ; 47 - Ambulance
+12 ;
+13 ; if not flat rate .....
+14 ;I '$D(ABMP("FLAT")) D ;abm*2.6*22 IHS/SD/SDR HEAT335246
+15 ;abm*2.6*22 IHS/SD/SDR HEAT335246
IF '$DATA(ABMP("FLAT"))!(($DATA(ABMP("FLAT")))&($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y"))
Begin DoDot:1
+16 NEW I
+17 FOR I=21,23,25,27,33,35,37,39,43,45,47
Begin DoDot:2
+18 ; dont get pharmacy if RX bill status is unbillable
+19 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),"^",3)="U"
IF I=23
QUIT
+20 ;this will make only viewable pages in CE show on bill, not everything
+21 ;I ABMP("VTYP")=998,((I'=21)&(I'=25)&(I'=27)&(I'=39)&(I'=45)&(I'=47)) Q ;dental ;abm*2.6*1 HEAT6395
+22 ;I ABMP("VTYP")=997,(I'=23) Q ;pharmacy ;abm*2.6*23 IHS/SD/SDR HEAT247169
+23 ;pharmacy ;abm*2.6*23 IHS/SD/SDR HEAT247169
IF ABMP("VTYP")=997
IF ((I'=23)&(I'=43))
QUIT
+24 ;lab
IF ABMP("VTYP")=996
IF (I'=37)
QUIT
+25 ;rad
IF ABMP("VTYP")=995
IF (I'=35)
QUIT
+26 ;ambulance
IF $GET(ABMP("CLIN"))="A3"
IF ((I'=43)&(I'=47))
QUIT
+27 ; get ancillary services revenue code info
DO @(I_"^ABMERGR2")
End DoDot:2
End DoDot:1
+28 ;
+29 ;start new code abm*2.6*11 HEAT117086
+30 ;I ABMP("ITYPE")="D" D ;abm*2.6*13 HEAT135507
+31 ;abm*2.6*21 IHS/SD/DR HEAT205579
IF (($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="ARBOR HEALTH PLAN")!($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"))&($DATA(ABMRV))
Begin DoDot:1
+32 ;the lines have been sequenced so don't do this ;abm*2.6*23 IHS/SD/SDR HEAT347035
IF +$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),"PO",0))'=0
QUIT
+33 SET ABMIS=$ORDER(ABMRV(0))
+34 ;S ABMJS=+$O(ABMRV(ABMIS,0)) ;abm*2.6*13 HEAT135507
+35 ;abm*2.6*13 HEAT135507
SET ABMJS=$ORDER(ABMRV(ABMIS,""))
+36 ;S ABMKS=$O(ABMRV(ABMIS,ABMJS,0)) ;abm*2.6*13 HEAT135507
+37 ;abm*2.6*13 HEAT135507
SET ABMKS=$ORDER(ABMRV(ABMIS,ABMJS,""))
+38 SET ABMI=0
+39 FOR
SET ABMI=$ORDER(ABMRV(ABMI))
IF 'ABMI
QUIT
Begin DoDot:2
+40 SET ABMJ=""
+41 FOR
SET ABMJ=$ORDER(ABMRV(ABMI,ABMJ))
IF $GET(ABMJ)=""
QUIT
Begin DoDot:3
+42 ;S ABMK=0 ;abm*2.6*13 HEAT135507
+43 ;abm*2.6*13 HEAT135507
SET ABMK=""
+44 FOR
SET ABMK=$ORDER(ABMRV(ABMI,ABMJ,ABMK))
IF 'ABMK
QUIT
Begin DoDot:4
+45 IF $PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,2)'="T1015"
QUIT
+46 ;start old abm*2.6*13 HEAT147327
+47 ;S ABMTMP("TMP")=$G(ABMRV(ABMIS,ABMJS,ABMKS))
+48 ;S ABMRV(ABMIS,ABMJS,ABMKS)=$G(ABMRV(ABMI,ABMJ,ABMK))
+49 ;S ABMRV(ABMI,ABMJ,ABMK)=$G(ABMTMP("TMP"))
+50 ;end old start new HEAT147327
+51 SET ABMTMP("TMP")=$GET(ABMRV(ABMIS,ABMJS,ABMKS))
+52 SET ABMRV(ABMIS,ABMJS,ABMKS)=$GET(ABMRV(ABMI,ABMJ,ABMK))
+53 SET ABMRV(ABMI,ABMJ,ABMK)=$GET(ABMTMP("TMP"))
+54 ;end new HEAT147327
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+55 KILL ABMI,ABMJ,ABMK,ABMTMP
+56 ;end new code HEAT117086
+57 ;
+58 IF $PIECE($GET(^DIC(40.7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)="A3"
Begin DoDot:1
+59 SET ABMODMOD=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,14)_$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,16)
+60 SET I=0
+61 FOR
SET I=$ORDER(ABMRV(I))
IF 'I
QUIT
Begin DoDot:2
+62 SET J=""
+63 SET J=$ORDER(ABMRV(I,J))
IF J=""
QUIT
Begin DoDot:3
+64 SET K=0
+65 FOR
SET K=$ORDER(ABMRV(I,J,K))
IF K=""
QUIT
Begin DoDot:4
+66 IF $PIECE(ABMRV(I,J,K),U,3)="QL"
SET ABMQLFLG=1
End DoDot:4
End DoDot:3
End DoDot:2
+67 SET I=0
+68 FOR
SET I=$ORDER(ABMRV(I))
IF 'I
QUIT
Begin DoDot:2
+69 SET J=""
+70 FOR
SET J=$ORDER(ABMRV(I,J))
IF J=""
QUIT
Begin DoDot:3
+71 SET K=0
+72 FOR
SET K=$ORDER(ABMRV(I,J,K))
IF K=""
QUIT
Begin DoDot:4
+73 IF $GET(ABMQLFLG)=1
IF ($PIECE(ABMRV(I,J,K),U,3)'="QL")
SET $PIECE(ABMRV(I,J,K),U,3)=""
+74 IF $GET(ABMQLFLG)'=1
SET $PIECE(ABMRV(I,J,K),U,3)=$SELECT($PIECE(ABMRV(I,J,K),U,3)="":ABMODMOD,1:$PIECE(ABMRV(I,J,K),U,3)_":"_ABMODMOD)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+75 KILL ABMQLFLG
+76 ;
+77 ; if flat rate ....
+78 IF $DATA(ABMP("FLAT"))
Begin DoDot:1
+79 NEW I
+80 FOR I=1:1:3
SET ABM(I)=$PIECE(ABMP("FLAT"),"^",I)
+81 ;abm*2.6*1 HEAT7884
IF (ABMP("VTYP")=999&(ABMP("BTYP")=731)&($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID"))
SET ABM(3)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),5)),U,7)
+82 SET ABMRV(+ABM(2),0,1)=+ABM(2)_"^^^^"_ABM(3)_"^"_($SELECT(+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)'=0:$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U),1:ABM(1)*ABM(3)))_"^^"_ABM(1)
+83 ;I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)'=0 S $P(ABMRV(+ABM(2),0,1),U,6)=(+$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,8))
+84 SET $PIECE(ABMRV(+ABM(2),0,1),U,10)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
+85 ;service date to ;abm*2.6*21 IHS/SD/SDR HEAT120880
SET $PIECE(ABMRV(+ABM(2),0,1),U,27)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,2)
+86 ;abm*2.6*8 5010
SET $PIECE(ABMRV(+ABM(2),0,1),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U,9)
+87 ;abm*2.6*1 HEAT5691
SET ABMP("CDAYS")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,3)
+88 IF +$GET(ABMP("CDAYS"))>0
Begin DoDot:2
+89 SET $PIECE(ABMRV(+ABM(2),0,1),U,5)=$GET(ABMP("CDAYS"))
+90 SET $PIECE(ABMRV(+ABM(2),0,1),U,6)=$GET(ABMP("CDAYS"))*ABM(1)
End DoDot:2
+91 SET ABMCPT=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16)
IF ABMCPT
Begin DoDot:2
+92 ;CSV-c
SET ABMCPT=$PIECE($$CPT^ABMCVAPI(ABMCPT,ABMP("VDT")),U,2)
+93 SET ABMP("CPT")=ABMCPT
+94 SET $PIECE(ABMRV(+ABM(2),0,1),U,2)=ABMCPT
+95 IF $GET(ABMP("EXP"))'=11
QUIT
+96 SET $PIECE(ABMRV(+ABM(2),"TOT"),U,2)=ABMCPT
End DoDot:2
+97 SET ABM(4)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U,6)
+98 IF ABM(4)
IF ABMP("VTYP")=111
SET $PIECE(ABMRV(+ABM(2),0,1),U,7)=(ABM(4)*ABM(1))
+99 IF ABM(4)
IF (+$GET(ABMP("CDAYS"))=0)
SET $PIECE(ABMRV(+ABM(2),0,1),U,5)=0
+100 ;start new abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT
+101 IF $$RCID^ABMERUTL(ABMP("INS"))=99999
Begin DoDot:2
+102 NEW I
+103 FOR I=23
Begin DoDot:3
+104 ;pharmacy
IF (ABMP("VTYP")'=997)
QUIT
+105 KILL ABM
+106 ; get ancillary services revenue code info
DO @(I_"^ABMERGR2")
+107 ;
+108 ;For AZ Medicaid make all rev codes 519
+109 SET A=0
+110 FOR
SET A=$ORDER(ABMRV(A))
IF 'A
QUIT
Begin DoDot:4
+111 SET B=-1
+112 FOR
SET B=$ORDER(ABMRV(A,B))
IF B=""
QUIT
Begin DoDot:5
+113 SET C=0
+114 FOR
SET C=$ORDER(ABMRV(A,B,C))
IF 'C
QUIT
Begin DoDot:6
+115 IF A=519
QUIT
+116 SET ABMRV(519,B,C)=$GET(ABMRV(A,B,C))
+117 KILL ABMRV(A,B,C)
End DoDot:6
End DoDot:5
End DoDot:4
+118 SET A=$ORDER(ABMRV(519,0))
+119 IF +A=0
QUIT
+120 SET B=$ORDER(ABMRV(519,A,0))
+121 ;S $P(ABMRV(519,A,B),U,6)=$P(ABMRV(519,0,1),U,6) ;put flat rate on first drug line ;abm*2.6*25 IHS/SD/SDR CR10016
+122 ;put flat rate on first drug line and piece 1 as 519 ;abm*2.6*25 IHS/SD/SDR CR10016
SET $PIECE(ABMRV(519,A,B),U,6)=$PIECE(ABMRV(519,0,1),U,6)
SET $PIECE(ABMRV(519,A,B),U)=519
+123 ;remove flat rate line
KILL ABMRV(519,0,1)
+124 ;start new abm*2.6*25 IHS/SD/SDR CR10016
+125 SET B=0
+126 FOR
SET B=$ORDER(ABMRV(519,B))
IF 'B
QUIT
Begin DoDot:4
+127 SET C=0
+128 FOR
SET C=$ORDER(ABMRV(519,B,C))
IF 'C
QUIT
Begin DoDot:5
+129 SET $PIECE(ABMRV(519,B,C),U)=519
End DoDot:5
End DoDot:4
+130 KILL A,B,C
+131 ;end new abm*2.6*25 IHS/SD/SDR CR10016
+132 ;end new abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT
End DoDot:3
End DoDot:2
+133 ;
+134 ;start old code abm*2.6*11 HEAT105003
+135 ;I ABMP("VTYP")=831 D
+136 ;.K ABMRV(+ABM(2),0),ABM("831SET")
+137 ;.N I
+138 ;.F I=21,27,35 D @(I_"^ABMERGR2")
+139 ;.S I=0
+140 ;.F S I=$O(ABMRV(I)) Q:'I D
+141 ;..N J
+142 ;..S J=0
+143 ;..F S J=$O(ABMRV(I,J)) Q:'J D
+144 ;...S K=0
+145 ;...F S K=$O(ABMRV(I,J,K)) Q:'K D
+146 ;....S $P(ABMRV(I,J,K),U,6)=0
+147 ;....S:'$G(ABM("831SET")) $P(ABMRV(I,J,K),U,6)=$P(ABMP("FLAT"),U),ABM("831SET")=1
+148 ;end old code HEAT105003
End DoDot:1
+149 KILL ABMCPT
+150 QUIT
+151 ;
FLP ;FORMAT LOOP
+1 FOR J=5,6,7
SET ABM("TOT",J)=0
+2 SET I=0
+3 FOR
SET I=$ORDER(ABMRV(I))
IF 'I
QUIT
Begin DoDot:1
+4 DO TOT
+5 FOR J=1:1:9
DO FMT
+6 SET ABMRV(I)=$TRANSLATE(ABMRV(I),"^")
End DoDot:1
+7 SET ABMRV(9999)="001^^^^"_ABM("TOT",5)_"^"_ABM("TOT",6)_"^"_ABM("TOT",7)
+8 SET ABMRV(9999,0)=ABMRV(9999)
+9 SET I=9999
+10 FOR J=1:1:9
DO FMT
+11 SET ABMRV(9999)=$TRANSLATE(ABMRV(9999),"^")
+12 KILL ABM
+13 QUIT
+14 ;
FMT ;Format
+1 SET ABM(J)=$PIECE(ABMRV(I),"^",J)
+2 IF J>4&(J<8)
SET ABM("TOT",J)=ABM("TOT",J)+ABM(J)
+3 SET ABM("FSTR")=$PIECE("4NR^5^2^2^7NR^10NRJ2^10NRJ2^4^12","^",J)
+4 SET ABM(J)=$$FMT^ABMERUTL(ABM(J),ABM("FSTR"))
+5 SET $PIECE(ABMRV(I),"^",J)=ABM(J)
+6 QUIT
+7 ;
TOT ;TOTAL TO REVENUE CODE
+1 SET J=-1
+2 FOR
SET J=$ORDER(ABMRV(I,J))
IF J=""
QUIT
Begin DoDot:1
+3 SET L=0
+4 FOR
SET L=$ORDER(ABMRV(I,J,L))
IF L=""
QUIT
Begin DoDot:2
+5 SET $PIECE(ABMRV(I),U,1)=I
+6 FOR K=2,3,4
SET $PIECE(ABMRV(I),U,K)=""
+7 FOR K=5,6,7
SET $PIECE(ABMRV(I),U,K)=$PIECE(ABMRV(I),U,K)+$PIECE(ABMRV(I,J,L),U,K)
End DoDot:2
End DoDot:1
+8 QUIT