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

ABMDF28R.m

Go to the documentation of this file. 
  1. ABMDF28R ; IHS/SD/SDR - PRINT UB-04 ;    
  1.  ;;2.6;IHS Third Party Billing;**1,2,4,6,9,10,11,13,19,20,21,22,23,27**;NOV 12, 2009;Build 486
  1.  ;IHS/SD/SDR-2.6*13-HEAT117086-T1015 should be top line for all Mcd
  1.  ;IHS/SD/SDR-2.6*19-HEAT116949-If DUZ(2)=4610 (Chapa-De/Auburn), make FL56=1124150891
  1.  ;IHS/SD/SDR-2.6*20-HEAT262141-Added code for AHCCCS RX.  Will print detail lines for all meds, but won't print price, only NDC, desc, date, and units.
  1.  ;IHS/SD/SDR-2.6*21-HEAT205579-Made T1015 print first for ARBOR HEALTH PLAN
  1.  ;IHS/SD/SDR-2.6*21-HEAT268438-check for 61044 from 61004 for Medi-Cal
  1.  ;IHS/SD/SDR-2.6*21-HEAT240744-call to resort,print lines for Medi-Cal dialysis billing
  1.  ;IHS/SD/SDR 2.6*22 HEAT335246 check new parm for printing itemized with first line printing flat rate and NDC.
  1.  ;IHS/SD/AML 2.6*23 CR8897 HEAT314802 Made changes for Medi-Cal from-thru billing
  1.  ;IHS/SD/SDR 2.6*23 HEAT347035 Changed how it was getting rev code
  1.  ;IHS/SD/SDR 2.6*27 CR10170 Changed the Medi-Cal check for box 50 to check if insurer name contains O/P Medi-Cal as well as 61044 check
  1.  ;
  1. 18A ;EP
  1.  F ABMCTR=ABMCTR:1:22 W !  ;get to line 23
  1.  S ABMDE="0001 TOTAL^^4"
  1.  I $$RCID^ABMERUTL(ABMP("INS"))["61044"  S ABMDE="001 TOTAL^^4"  ;abm*2.6*21 HEAT268438
  1.  D WRT^ABMDF28W
  1.  S ABMDE=ABMPGCNT_"    "_ABMPGTOT_"^10^15"  ;page #
  1.  D WRT^ABMDF28W  ;#43
  1.  S ABMDE=$$MDY^ABMDUTL($S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0)),U),$G(ABMP("PRINTDT"))="A":$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5),1:DT))_"^45^20"  ;create dt
  1.  D WRT^ABMDF28W
  1.  S ABMDE=$TR($FN(ABMRV("ZZTOT"),"T",2),".")_"^60^10R"  ;Grand tot
  1.  D WRT^ABMDF28W  ;last item in desc section
  1.  I +ABMRV("NCTOT") D
  1.  .S ABMDE=$TR($FN(ABMRV("NCTOT"),"T",2),".")_"^69^10R"
  1.  .D WRT^ABMDF28W  ;Grand tot-noncovered items
  1.  .Q
  1.  K ABMRV
  1.  W !
  1.  S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
  1.  S ABMDE=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")  ;NPI-#56
  1.  I DUZ(2)=4610,($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")="EDS/CDP") S ABMDE=1124150891
  1.  S ABMDE=ABMDE_"^68^15"
  1.  D WRT^ABMDF28W
  1.  Q
  1. 42 ;
  1.  ;Lines 42 - 44
  1.  K ABMP("SET")
  1.  D ^ABMER30  ;get ins, pymt data
  1.  N I
  1.  F I=1:1:3 D  ;check for blank entries; if any, move others up
  1.  .I '$D(ABMREC(30,I)) D
  1.  ..S ABMREC(30,I)=$G(ABMREC(30,(I+1)))
  1.  ..S ABMREC(31,I)=$G(ABMREC(31,(I+1)))
  1.  F I=1:1:3 D
  1.  .W !
  1.  .;Q:'$D(ABMREC(30,I))  ;HEAT144755
  1.  .Q:$TR(ABMREC(30,I),"")=""  ;HEAT144755
  1.  .;Ins name_" "_Payor Sub ID
  1.  .S ABMDE=$S($E(ABMREC(30,I),54,78)["RAILROAD":"RAILROAD MEDICARE",1:$E(ABMREC(30,I),54,78))_" "_$E(ABMREC(30,I),31,34)_"^^22"
  1.  .;I $$RCID^ABMERUTL(+$G(ABMP("INS",I)))=61044 S ABMDE="O/P MEDI-CAL^^22"  ;abm*2.6*19 HEAT116949
  1.  .;I $$RCID^ABMERUTL(+$G(ABMP("INS",I)))["61044" S ABMDE="O/P MEDI-CAL^^22"  ;abm*2.6*19 HEAT116949  ;abm*2.6*27 IHS/SD/SDR CR10170
  1.  .I (($$RCID^ABMERUTL(+$G(ABMP("INS",I)))["61044")&($E(ABMREC(30,I),54,78)["O/P MEDI-CAL")) S ABMDE="O/P MEDI-CAL^^22"  ;abm*2.6*27 IHS/SD/SDR CR10170
  1.  .D WRT^ABMDF28W  ;#50
  1.  .S ABMDE=$E(ABMREC(30,I),160,172)_"^23^15"  ;Provider ID (blank)
  1.  .I $P($G(^AUTNINS(ABMP("INS"),0)),U)="IOWA MEDICAID" S ABMDE="^23^15"
  1.  .D WRT^ABMDF28W  ;#51
  1.  .S ABMDE=$E(ABMREC(30,I),142)_"^38^1"  ;Release code
  1.  .D WRT^ABMDF28W  ;#52
  1.  .S ABMDE=$E(ABMREC(30,I),143)_"^41^1"  ;Ben Assgn Indicator
  1.  .D WRT^ABMDF28W  ;#53
  1.  .S ABMDE=+$E(ABMREC(30,I),173,182)_" ^43^10R"  ;3PB pymt receive
  1.  .I +ABMDE D WRT^ABMDF28W  ;#54
  1.  .S ABMDE=+$E(ABMREC(30,I),183,192)_" ^55^10R"  ;Est 3PB amt due
  1.  .I +ABMDE D WRT^ABMDF28W  ;#55
  1.  .I I=1 D  ;other prov ID-#57
  1.  ..S Y=$P($G(^ABMNINS(ABMP("LDFN"),+ABMP("INS",I),1,ABMP("VTYP"),0)),U,8)
  1.  ..S:Y="" Y=$P($G(^AUTNINS(+ABMP("INS",I),15,ABMP("LDFN"),0)),U,2)
  1.  ..S:Y="" Y=$TR($P($G(^AUTTLOC(DUZ(2),0)),U,18),"-")
  1.  ..Q:$P($G(^AUTNINS(ABMP("INS"),0)),U)["VMBP"  ;abm*2.6*11 IHS/SD/AML 7/30/2013 RQMT_94
  1.  ..S ABMDE=Y_"^67^15"
  1.  ..I $P($G(^AUTNINS(ABMP("INS"),0)),U)="IOWA MEDICAID" S ABMDE="^67^15"
  1.  ..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)=2 D PRIMECK^ABMDF28V  ;abm*2.6*21 HEAT97615
  1.  ..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)=2,$G(ABMTSIFG)=1 Q  ;don't write #57 if Medicare & TSI billed  ;abm*2.6*21 HEAT97615
  1.  ..D WRT^ABMDF28W
  1.  K ABMR
  1.  Q