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

ABME601.m

Go to the documentation of this file. 
  1. ABME601 ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 01 (Processor Label Data) ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;DMJ;07/08/96 4:53 PM Created routine
  1.  ;
  1.  ; IHS/ASDS/DMJ - 01/23/01 - V2.4 Patch 3 - NOIS HQW-0101-100032
  1.  ;   Created to correct rejections for Medicare electronic trans.
  1.  ;
  1.  ; IHS/ASDS/SDH - 09/27/01 - V2.4 Patch 9 - NOIS XAA-0901-20095
  1.  ;     After moving Kidscare to Page 5 from Page 7 found that there are
  1.  ;     checks that are done for Medicaid that should also be done for
  1.  ;     Kidscare.
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. START ;START HERE
  1.  K ABMREC(1),ABMR(1)
  1.  S ABME("RTYPE")=1
  1.  D BCBS^ABMERUTL
  1.  D LOOP
  1.  K ABME,ABM
  1.  Q
  1. LOOP ;LOOP HERE
  1.  F I=10:10:270 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),1,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(1)=$G(ABMREC(1))_ABMR(1,I)
  1.  Q
  1. 10 ;Record type, 1-2
  1.  S ABMR(1,10)="01"
  1.  Q
  1. 20 ;Submitter EIN, 3-12 (SOURCE: FILE=9999999.06, FIELD=.21)
  1.  D DIQ2 S ABMR(1,20)=ABM(9999999.06,DUZ(2),.21,"E")
  1.  S ABMR(1,20)=+$TR(ABMR(1,20),"-")
  1.  S ABMR(1,20)=$$FMT^ABMERUTL(ABMR(1,20),"10NR")
  1.  S ABMRT(99,20)=ABMR(1,20)
  1.  Q
  1. 30 ;Multiple Provider Billing, 13 
  1.  S ABMR(1,30)=1
  1.  Q
  1. 40 ;Filler (National Use), 14-30
  1.  S ABMR(1,40)=""
  1.  S ABMR(1,40)=$$FMT^ABMERUTL(ABMR(1,40),17)
  1.  Q
  1. 50 ;Receiver Type Code, 31 (SOURCE: FILE=9999999.18, FIELD=.21)
  1.  S ABMR(1,50)=$S(ABMP("ITYPE")="W":"B",ABMP("ITYPE")="R":"C",ABMP("ITYPE")="D"!(ABMP("ITYPE")="K"):"D",ABMP("ITYPE")="P":"F",ABMP("ITYPE")="C":"H",$G(ABMP("BCBS")):"G",1:"I")
  1.  S ABMR(1,50)=$$FMT^ABMERUTL(ABMR(1,50),1)
  1.  Q
  1. 60 ;Receiver Identification, 32-36 (SOURCE: FILE=9999999.18, FIELD=.08)
  1.  S ABMR(1,60)=$$RCID^ABMERUTL(ABMP("INS"))
  1.  Q
  1. 70 ;Receiver Sub-Identification, 37-40
  1.  S ABMR(1,70)=""
  1.  S ABMR(1,70)=$$FMT^ABMERUTL(ABMR(1,70),4)
  1.  Q
  1. 80 ;Filler (National Use) 41-46
  1.  S ABMR(1,80)=""
  1.  S ABMR(1,80)=$$FMT^ABMERUTL(ABMR(1,80),6)
  1.  Q
  1. 90 ;Submitter Name, 47-67 (SOURCE: FILE=9999999.06, FIELD=.01)
  1.  D DIQ2 S ABMR(1,90)=ABM(9999999.06,DUZ(2),.01,"E")
  1.  S ABMR(1,90)=$$FMT^ABMERUTL(ABMR(1,90),21)
  1.  Q
  1. 100 ;Submitter Address, 68-85 (SOURCE: FILE=9999999.06, FIELD=.14)
  1.  D DIQ2 S ABMR(1,100)=ABM(9999999.06,DUZ(2),.14,"E")
  1.  S ABMR(1,100)=$$FMT^ABMERUTL(ABMR(1,100),18)
  1.  Q
  1. 110 ;Submitter City, 86-100 (SOURCE: FILE=9999999.06 FIELD=.15)
  1.  D DIQ2 S ABMR(1,110)=ABM(9999999.06,DUZ(2),.15,"E")
  1.  S ABMR(1,110)=$$FMT^ABMERUTL(ABMR(1,110),15)
  1.  Q
  1. 120 ;Submitter State, 101-102 (SOURCE: FILE=9999999.06, FIELD=.16)
  1.  D DIQ2 S ABMR(1,120)=ABM(9999999.06,DUZ(2),.16,"I")
  1.  S ABMR(1,120)=$P($G(^DIC(5,+ABMR(1,120),0)),"^",2)
  1.  S ABMR(1,120)=$$FMT^ABMERUTL(ABMR(1,120),2)
  1.  Q
  1. 130 ;Submitter Zip, 103-111 (SOURCE: FILE=9999999.06, FIELD=.17)
  1.  D DIQ2 S ABMR(1,130)=ABM(9999999.06,DUZ(2),.17,"E")
  1.  S ABMR(1,130)=$$FMT^ABMERUTL(ABMR(1,130),9)
  1.  Q
  1. 140 ;Submitter FAX Number, 112-121 (SOURCE: FILE=, FIELD=)
  1.  S ABMR(1,140)=""
  1.  S ABMR(1,140)=$$FMT^ABMERUTL(ABMR(1,140),"10R")
  1.  Q
  1. 150 ;Country Code, 122-125 (SOURCE: FILE= FIELD=)
  1.  S ABMR(1,150)=""
  1.  S ABMR(1,150)=$$FMT^ABMERUTL(ABMR(1,150),4)
  1.  Q
  1. 160 ;Submitter Telephone Number, 126-135 (SOURCE: FILE=, FIELD=)
  1.  D DIQ2 S ABMR(1,160)=ABM(9999999.06,DUZ(2),.13,"E")
  1.  S ABMR(1,160)=$TR(ABMR(1,160),"() -")
  1.  S ABMR(1,160)=$$FMT^ABMERUTL(ABMR(1,160),"10R")
  1.  Q
  1. 170 ;File Sequence & Serial Number,136-142 (SOURCE: FILE= FIELD=)
  1.  S ABMR(1,170)=$P($G(^ABMDTXST(DUZ(2),+$G(ABMP("XMIT")),1)),"^",6)
  1.  I ABMR(1,170)="" D
  1.  .S ABMR(1,170)="0000"_$G(ABMP("XMIT"))
  1.  .S ABMR(1,170)=$E(ABMR(1,170),$L(ABMR(1,170))-3,$L(ABMR(1,170)))
  1.  .S ABMR(1,170)=$E(DUZ(2),$L(DUZ(2))-1,$L(DUZ(2)))_ABMR(1,170)
  1.  .S ABMR(1,170)=ABMR(1,170)+1000000
  1.  S ABMR(1,170)=$$FMT^ABMERUTL(ABMR(1,170),"7NR")
  1.  Q
  1. 180 ;Test/Production Indicator, 143-146 (SOURCE: FILE=9002274.09, FIELD=.04)
  1.  S ABMR(1,180)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",4)
  1.  S ABMR(1,180)=""
  1.  S ABMR(1,180)=$$FMT^ABMERUTL(ABMR(1,180),4)
  1.  Q
  1. 190 ;Date of Receipt, 147-154
  1.  S ABMR(1,190)=""
  1.  S ABMR(1,190)=$$FMT^ABMERUTL(ABMR(1,190),8)
  1.  Q
  1. 200 ;Processing Date, 155-162
  1.  S ABMR(1,200)=$$Y2KD2^ABMDUTL(DT)
  1.  S ABMR(1,200)=$$FMT^ABMERUTL(ABMR(1,200),8)
  1.  Q
  1. 210 ;Filler (163-165)
  1.  S ABMR(1,210)=""
  1.  S ABMR(1,210)=$$FMT^ABMERUTL(ABMR(1,210),3)
  1.  Q
  1. 220 ;Password (166-171)
  1.  S ABMR(1,220)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",3)
  1.  S ABMR(1,220)=$$FMT^ABMERUTL(ABMR(1,220),6)
  1.  Q
  1. 230 ;Submitter ID (172-177)
  1.  S ABMR(1,230)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",2)
  1.  S ABMR(1,230)=$$FMT^ABMERUTL(ABMR(1,230),6)
  1.  Q
  1. 240 ;Filler (178)
  1.  S ABMR(1,240)=""
  1.  S ABMR(1,240)=$$FMT^ABMERUTL(ABMR(1,240),1)
  1.  Q
  1. 250 ;Arizona Medicaid Transmission Number (179-184)
  1.  ;Use the last 6 digits of Batch ID
  1.  S ABMR(1,250)=""
  1.  I $$RCID^ABMERUTL(ABMP("INS"))=99999 S ABMR(1,250)=$E(ABMR(1,170),2,7)
  1.  S ABMR(1,250)=$$FMT^ABMERUTL(ABMR(1,250),"6R")
  1.  Q
  1. 260 ;Filler (185-189)
  1.  S ABMR(1,260)=""
  1.  S ABMR(1,260)=$$FMT^ABMERUTL(ABMR(1,260),5)
  1.  Q
  1. 270 ;Version Code (190-192)
  1.  S ABMR(1,270)="060"
  1.  Q
  1. DIQ1 ;PULL BILL DATA VIA DIQ1
  1.  Q:$D(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
  1.  N I S DIQ="ABM(",DIQ(0)="EI",DIC="^ABMDBILL(DUZ(2),",DA=ABMP("BDFN")
  1.  S DR=".01;.21;.51;.52;.53;.61;.62;.63;.64;.71;.72;.99"
  1.  D EN^DIQ1 K DIQ
  1.  Q
  1. DIQ2 ;GET LOCATION INFORMATION
  1.  Q:$D(ABM(9999999.06,DUZ(2)))
  1.  N I S DIQ="ABM",DIQ(0)="IE",DIC="^AUTTLOC(",DA=DUZ(2)
  1.  S DR=".01;.13;.14;.15;.16;.17;.21"
  1.  D EN^DIQ1 K DIQ
  1.  Q
  1. EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE (X=data element, Y=bill internal entry number)
  1.  S ABMP("BDFN")=ABMY D SET^ABMERUTL
  1.  I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
  1.  D @ABMX
  1.  S Y=ABMR(20,ABMX)
  1.  K ABMR(20,ABMX),ABME,ABM,ABMX,ABMY
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  Q Y