Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMERGRV

ABMERGRV.m

Go to the documentation of this file. 
  1. 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
  1.  ;Original;DMJ;01/26/96 4:02 PM
  1.  ; IHS/SD/SDR 2.5 p8 task 6 Added code for new ambulance multiple 47
  1.  ; IHS/SD/SDR 2.5 p9 IM18857 Added code to print FL45
  1.  ; IHS/SD/SDR 2.5 p10 IM20395 Split out lines bundled by rev code
  1.  ; IHS/SD/SDR 2.5 p10 IM20396 Made change to fix covered days amount when there aren't any covered days
  1.  ;
  1.  ;IHS/SD/SDR 2.6 CSV
  1.  ;IHS/SD/SDR 2.6*1 HEAT5691 Correction for covered days
  1.  ;IHS/SD/SDR 2.6*1 HEAT6395 allow dental codes to print on UB
  1.  ;IHS/SD/SDR 2.6*1 HEAT7884
  1.  ;IHS/SD/SDR 2.6*13 HEAT135507 fix for <SUBSCR>P1+39^ABMERGRV
  1.  ;IHS/SD/SDR 2.6*13 HEAT117086 Removed code to put T1015 as top line; it doesn't work here.
  1.  ;IHS/SD/AML 2.6*20 HEAT262141 Made changes for AHCCCS RX billing
  1.  ;IHS/SD/SDR 2.6*21 HEAT120880 Updated so flat rate will have service from and service to dates
  1.  ;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
  1.  ;  printing with the flat rate or the flat rate printing on the first line item.
  1.  ;IHS/SD/SDR 2.6*23 HEAT247169 Added code to check subfile 43 if visit type is 997.
  1.  ;IHS/SD/SDR 2.6*23 HEAT347035 Added quit if print order was selected to not do the T1015-on-top thing
  1.  ;IHS/SD/SDR 2.6*25 CR10016 Made change to fix Arizona Medicaid pharmacy billing rev code 519
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. START ;START HERE
  1.  K ABM,ABMRV
  1.  D ORV
  1.  D P1
  1.  D FLP
  1.  Q
  1.  ;
  1. ORV ; EP
  1.  ; OTHER REVENUE CODE
  1.  ; ABMRV(IEN to REVENUE CODE,0) = IEN to REVENUE CODE ^ ^ ^ ^ 1 ^
  1.  ;           Revenue charge ^ ^ Revenue charge
  1.  I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",7) D
  1.  .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)
  1.  Q
  1.  ;
  1. P1 ;EP - SET UP ABMRV ARRAY
  1.  ; 21 - Med/Surg
  1.  ; 23 - Pharmacy
  1.  ; 25 - Room and Board
  1.  ; 27 - Medical Procedures
  1.  ; 33 - Dental
  1.  ; 35 - Radiology
  1.  ; 37 - Laboratory
  1.  ; 39 - Anesthesia
  1.  ; 43 - Miscellaneous Services
  1.  ; 45 - Supplies
  1.  ; 47 - Ambulance
  1.  ; 
  1.  ; if not flat rate .....
  1.  ;I '$D(ABMP("FLAT")) D  ;abm*2.6*22 IHS/SD/SDR HEAT335246
  1.  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
  1.  .N I
  1.  .F I=21,23,25,27,33,35,37,39,43,45,47 D
  1.  ..; dont get pharmacy if RX bill status is unbillable
  1.  ..I $P($G(^AUTNINS(ABMP("INS"),2)),"^",3)="U",I=23 Q
  1.  ..;this will make only viewable pages in CE show on bill, not everything
  1.  ..;I ABMP("VTYP")=998,((I'=21)&(I'=25)&(I'=27)&(I'=39)&(I'=45)&(I'=47)) Q  ;dental  ;abm*2.6*1 HEAT6395
  1.  ..;I ABMP("VTYP")=997,(I'=23) Q  ;pharmacy  ;abm*2.6*23 IHS/SD/SDR HEAT247169
  1.  ..I ABMP("VTYP")=997,((I'=23)&(I'=43)) Q  ;pharmacy  ;abm*2.6*23 IHS/SD/SDR HEAT247169
  1.  ..I ABMP("VTYP")=996,(I'=37) Q  ;lab
  1.  ..I ABMP("VTYP")=995,(I'=35) Q  ;rad
  1.  ..I $G(ABMP("CLIN"))="A3",((I'=43)&(I'=47)) Q  ;ambulance
  1.  ..D @(I_"^ABMERGR2")  ; get ancillary services revenue code info
  1.  ;
  1.  ;start new code abm*2.6*11 HEAT117086
  1.  ;I ABMP("ITYPE")="D" D  ;abm*2.6*13 HEAT135507
  1.  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
  1.  .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
  1.  .S ABMIS=$O(ABMRV(0))
  1.  .;S ABMJS=+$O(ABMRV(ABMIS,0))  ;abm*2.6*13 HEAT135507
  1.  .S ABMJS=$O(ABMRV(ABMIS,""))  ;abm*2.6*13 HEAT135507
  1.  .;S ABMKS=$O(ABMRV(ABMIS,ABMJS,0))  ;abm*2.6*13 HEAT135507
  1.  .S ABMKS=$O(ABMRV(ABMIS,ABMJS,""))  ;abm*2.6*13 HEAT135507
  1.  .S ABMI=0
  1.  .F  S ABMI=$O(ABMRV(ABMI)) Q:'ABMI  D
  1.  ..S ABMJ=""
  1.  ..F  S ABMJ=$O(ABMRV(ABMI,ABMJ)) Q:$G(ABMJ)=""  D
  1.  ...;S ABMK=0  ;abm*2.6*13 HEAT135507
  1.  ...S ABMK=""  ;abm*2.6*13 HEAT135507
  1.  ...F  S ABMK=$O(ABMRV(ABMI,ABMJ,ABMK)) Q:'ABMK  D
  1.  ....I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,2)'="T1015" Q
  1.  ....;start old abm*2.6*13 HEAT147327
  1.  ....;S ABMTMP("TMP")=$G(ABMRV(ABMIS,ABMJS,ABMKS))
  1.  ....;S ABMRV(ABMIS,ABMJS,ABMKS)=$G(ABMRV(ABMI,ABMJ,ABMK))
  1.  ....;S ABMRV(ABMI,ABMJ,ABMK)=$G(ABMTMP("TMP"))
  1.  ....;end old start new HEAT147327
  1.  ....S ABMTMP("TMP")=$G(ABMRV(ABMIS,ABMJS,ABMKS))
  1.  ....S ABMRV(ABMIS,ABMJS,ABMKS)=$G(ABMRV(ABMI,ABMJ,ABMK))
  1.  ....S ABMRV(ABMI,ABMJ,ABMK)=$G(ABMTMP("TMP"))
  1.  ....;end new HEAT147327
  1.  K ABMI,ABMJ,ABMK,ABMTMP
  1.  .;end new code HEAT117086
  1.  ;
  1.  I $P($G(^DIC(40.7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)="A3" D
  1.  .S ABMODMOD=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,14)_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,16)
  1.  .S I=0
  1.  .F  S I=$O(ABMRV(I)) Q:'I  D
  1.  ..S J=""
  1.  ..S J=$O(ABMRV(I,J)) Q:J=""  D
  1.  ...S K=0
  1.  ...F  S K=$O(ABMRV(I,J,K)) Q:K=""  D
  1.  ....I $P(ABMRV(I,J,K),U,3)="QL" S ABMQLFLG=1
  1.  .S I=0
  1.  .F  S I=$O(ABMRV(I)) Q:'I  D
  1.  ..S J=""
  1.  ..F  S J=$O(ABMRV(I,J)) Q:J=""  D
  1.  ...S K=0
  1.  ...F  S K=$O(ABMRV(I,J,K)) Q:K=""  D
  1.  ....I $G(ABMQLFLG)=1,($P(ABMRV(I,J,K),U,3)'="QL") S $P(ABMRV(I,J,K),U,3)=""
  1.  ....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)
  1.  K ABMQLFLG
  1.  ;
  1.  ; if flat rate ....
  1.  I $D(ABMP("FLAT")) D
  1.  .N I
  1.  .F I=1:1:3 S ABM(I)=$P(ABMP("FLAT"),"^",I)
  1.  .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
  1.  .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)
  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))
  1.  .S $P(ABMRV(+ABM(2),0,1),U,10)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
  1.  .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
  1.  .S $P(ABMRV(+ABM(2),0,1),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U,9)  ;abm*2.6*8 5010
  1.  .S ABMP("CDAYS")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,3)  ;abm*2.6*1 HEAT5691
  1.  .I +$G(ABMP("CDAYS"))>0 D
  1.  ..S $P(ABMRV(+ABM(2),0,1),U,5)=$G(ABMP("CDAYS"))
  1.  ..S $P(ABMRV(+ABM(2),0,1),U,6)=$G(ABMP("CDAYS"))*ABM(1)
  1.  .S ABMCPT=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16) I ABMCPT D
  1.  ..S ABMCPT=$P($$CPT^ABMCVAPI(ABMCPT,ABMP("VDT")),U,2)  ;CSV-c
  1.  ..S ABMP("CPT")=ABMCPT
  1.  ..S $P(ABMRV(+ABM(2),0,1),U,2)=ABMCPT
  1.  ..Q:$G(ABMP("EXP"))'=11
  1.  ..S $P(ABMRV(+ABM(2),"TOT"),U,2)=ABMCPT
  1.  .S ABM(4)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U,6)
  1.  .I ABM(4),ABMP("VTYP")=111 S $P(ABMRV(+ABM(2),0,1),U,7)=(ABM(4)*ABM(1))
  1.  .I ABM(4),(+$G(ABMP("CDAYS"))=0) S $P(ABMRV(+ABM(2),0,1),U,5)=0
  1.  .;start new abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT
  1.  .I $$RCID^ABMERUTL(ABMP("INS"))=99999 D
  1.  ..N I
  1.  ..F I=23 D
  1.  ...Q:(ABMP("VTYP")'=997)  ;pharmacy
  1.  ...K ABM
  1.  ...D @(I_"^ABMERGR2")  ; get ancillary services revenue code info
  1.  ...;
  1.  ...;For AZ Medicaid make all rev codes 519
  1.  ...S A=0
  1.  ...F  S A=$O(ABMRV(A)) Q:'A  D
  1.  ....S B=-1
  1.  ....F  S B=$O(ABMRV(A,B)) Q:B=""  D
  1.  .....S C=0
  1.  .....F  S C=$O(ABMRV(A,B,C)) Q:'C  D
  1.  ......Q:A=519
  1.  ......S ABMRV(519,B,C)=$G(ABMRV(A,B,C))
  1.  ......K ABMRV(A,B,C)
  1.  ...S A=$O(ABMRV(519,0))
  1.  ...Q:+A=0
  1.  ...S B=$O(ABMRV(519,A,0))
  1.  ...;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
  1.  ...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
  1.  ...K ABMRV(519,0,1)  ;remove flat rate line
  1.  ...;start new abm*2.6*25 IHS/SD/SDR CR10016
  1.  ...S B=0
  1.  ...F  S B=$O(ABMRV(519,B)) Q:'B  D
  1.  ....S C=0
  1.  ....F  S C=$O(ABMRV(519,B,C)) Q:'C  D
  1.  .....S $P(ABMRV(519,B,C),U)=519
  1.  ...K A,B,C
  1.  ...;end new abm*2.6*25 IHS/SD/SDR CR10016
  1.  ...;end new abm*2.6*20 IHS/SD/AML HEAT262141 1/4/2016 - AHCCCS RX REQUIREMENT
  1.  .;
  1.  .;start old code abm*2.6*11 HEAT105003
  1.  .;I ABMP("VTYP")=831 D
  1.  .;.K ABMRV(+ABM(2),0),ABM("831SET")
  1.  .;.N I
  1.  .;.F I=21,27,35 D @(I_"^ABMERGR2")
  1.  .;.S I=0
  1.  .;.F  S I=$O(ABMRV(I)) Q:'I  D
  1.  .;..N J
  1.  .;..S J=0
  1.  .;..F  S J=$O(ABMRV(I,J)) Q:'J  D
  1.  .;...S K=0
  1.  .;...F  S K=$O(ABMRV(I,J,K)) Q:'K  D
  1.  .;....S $P(ABMRV(I,J,K),U,6)=0
  1.  .;....S:'$G(ABM("831SET")) $P(ABMRV(I,J,K),U,6)=$P(ABMP("FLAT"),U),ABM("831SET")=1
  1.  .;end old code HEAT105003
  1.  K ABMCPT
  1.  Q
  1.  ;
  1. FLP ;FORMAT LOOP
  1.  F J=5,6,7 S ABM("TOT",J)=0
  1.  S I=0
  1.  F  S I=$O(ABMRV(I)) Q:'I  D
  1.  .D TOT
  1.  .F J=1:1:9 D FMT
  1.  .S ABMRV(I)=$TR(ABMRV(I),"^")
  1.  S ABMRV(9999)="001^^^^"_ABM("TOT",5)_"^"_ABM("TOT",6)_"^"_ABM("TOT",7)
  1.  S ABMRV(9999,0)=ABMRV(9999)
  1.  S I=9999
  1.  F J=1:1:9 D FMT
  1.  S ABMRV(9999)=$TR(ABMRV(9999),"^")
  1.  K ABM
  1.  Q
  1.  ;
  1. FMT ;Format
  1.  S ABM(J)=$P(ABMRV(I),"^",J)
  1.  I J>4&(J<8) S ABM("TOT",J)=ABM("TOT",J)+ABM(J)
  1.  S ABM("FSTR")=$P("4NR^5^2^2^7NR^10NRJ2^10NRJ2^4^12","^",J)
  1.  S ABM(J)=$$FMT^ABMERUTL(ABM(J),ABM("FSTR"))
  1.  S $P(ABMRV(I),"^",J)=ABM(J)
  1.  Q
  1.  ;
  1. TOT ;TOTAL TO REVENUE CODE
  1.  S J=-1
  1.  F  S J=$O(ABMRV(I,J)) Q:J=""  D
  1.  .S L=0
  1.  .F  S L=$O(ABMRV(I,J,L)) Q:L=""  D
  1.  ..S $P(ABMRV(I),U,1)=I
  1.  ..F K=2,3,4 S $P(ABMRV(I),U,K)=""
  1.  ..F K=5,6,7 S $P(ABMRV(I),U,K)=$P(ABMRV(I),U,K)+$P(ABMRV(I,J,L),U,K)
  1.  Q