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

ABMEBA0.m

Go to the documentation of this file. 
  1. ABMEBA0 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD BA0 (Provider) Envoy version ;     
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/ASDS/DMJ - 03/01/01 - V2.4 P5 - NOIS HQW-0301-100010
  1.  ;    This is a new routine for a new Envoy electronic format
  1.  ;
  1.  ; IHS/FCS/DRS - Patch 9 Part 4b - Provider Specialty, at tag 220
  1.  ;
  1. START ;START HERE
  1.  K ABMREC(10),ABMR(10)
  1.  S ABME("RTYPE")=10
  1.  D LOOP
  1.  S ABMRT(95,"RTOT")=+$G(ABMRT(95,"RTOT"))+1
  1.  K ABME,ABM
  1.  Q
  1.  ;
  1. LOOP ;LOOP HERE
  1.  F I=10:10:280 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),10,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(10)=$G(ABMREC(10))_ABMR(10,I)
  1.  Q
  1.  ;
  1. 10 ;Record type
  1.  S ABMR(10,10)="BA0"
  1.  Q
  1. 20 ;4-18 EMC Provider ID
  1.  S ABMR(10,20)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,8)
  1.  S:ABMR(10,20)="" ABMR(10,20)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
  1.  S:ABMR(10,20)="" ABMR(10,20)=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),"^",2)
  1.  S ABMP("EMCPRID")=ABMR(10,20)
  1.  S ABMR(10,20)=$$FMT^ABMERUTL(ABMR(10,20),15)
  1.  Q
  1. 30 ;19-21 Type of Batch
  1.  S ABMR(10,30)=100
  1.  S:ABMP("VTYP")=998 ABMR(10,30)=200
  1.  S:ABMP("VTYP")=997 ABMR(10,30)=300
  1.  S ABMP("TOB")=ABMR(10,30)
  1.  Q
  1.  ;
  1. 40 ;22-25 Batch Number
  1.  S ABMR(10,40)=$G(ABMEF("BATCH#"))
  1.  S ABMR(10,40)=$$FMT^ABMERUTL(ABMR(10,40),"4NR")
  1.  Q
  1. 50 ;26-31 Batch ID
  1.  S ABMR(10,50)=$G(ABMR(1,50))
  1.  S ABMR(10,50)=$$FMT^ABMERUTL(ABMR(10,50),6)
  1.  Q
  1. 60 ;32-40 Federal Tax ID or EIN
  1.  D DIQ1
  1.  S ABMR(10,60)=ABM(9999999.06,ABMP("LDFN"),.21,"E")
  1.  S ABMR(10,60)=$$FMT^ABMERUTL(ABMR(10,60),"9S")
  1.  S ABMRT(95,60)=ABMR(10,60)
  1.  Q
  1. 70 ;41-46 Filler
  1.  S ABMR(10,70)=""
  1.  S ABMR(10,70)=$$FMT^ABMERUTL(ABMR(10,70),6)
  1.  Q
  1. 80 ;47-47 Provider Tax ID Type
  1.  S ABMR(10,80)="E"
  1.  S ABMR(10,80)=$$FMT^ABMERUTL(ABMR(10,80),1)
  1.  Q
  1. 90 ;48-62 Medicare Provider Number
  1.  S ABMR(10,90)=""
  1.  I ABMP("ITYPE")="R" D
  1.  .S ABMR(10,90)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,8)
  1.  .S:ABMR(10,90)="" ABMR(10,90)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
  1.  .S:ABMR(10,90)="" ABMR(10,60)=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),"^",2)
  1.  .I ABMR(10,90)="" D
  1.  ..D DIQ1
  1.  ..S ABMR(10,90)=ABM(9999999.06,ABMP("LDFN"),.22,"E")
  1.  ..Q
  1.  .S ABMR(10,90)=$TR(ABMR(10,90),"-")
  1.  S ABMR(10,90)=$$FMT^ABMERUTL(ABMR(10,90),15)
  1.  Q
  1. 100 ;63-68 Provider UPIN-USIN ID
  1.  S ABMR(10,100)=$$UPIN^ABMEEPRV(ABMAPRV)
  1.  S ABMR(10,100)=$$FMT^ABMERUTL(ABMR(10,100),6)
  1.  Q
  1. 110 ;69-74 Filler
  1.  S ABMR(10,110)=""
  1.  S ABMR(10,110)=$$FMT^ABMERUTL(ABMR(10,110),6)
  1.  Q
  1. 120 ;75-89 Medicaid Provider Number (SOURCE: FILE=9999999.181501, FIELD=.02)
  1.  S ABMR(10,120)=""
  1.  I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") S ABMR(10,120)=$G(ABMR(10,20))
  1.  S ABMR(10,120)=$$FMT^ABMERUTL(ABMR(10,120),15)
  1.  Q
  1.  ;
  1. 130 ;90-104 Champus Insurer Provider Number
  1.  ; (SOURCE: FILE=9999999.181501, FIELD=.02)
  1.  S ABMR(10,130)=""
  1.  S ABMR(10,130)=$$FMT^ABMERUTL(ABMR(10,130),15)
  1.  Q
  1. 140 ;105-119 Provider BC/BS Number
  1.  S ABMR(10,140)=""
  1.  I $G(ABMP("BCBS")) D
  1.  .D DIQ1
  1.  .S ABMR(10,140)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,8)
  1.  .S:ABMR(10,140)="" ABMR(10,140)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
  1.  .S:ABMR(10,140)="" ABMR(10,140)=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),"^",2)
  1.  .S ABMR(10,140)=ABMR(10,140)_" "_$E(ABM(9999999.06,ABMP("LDFN"),.01,"E"),1,2)
  1.  S ABMR(10,140)=$$FMT^ABMERUTL(ABMR(10,140),15)
  1.  Q
  1. 150 ;120-134 Provider Commercial Number
  1.  S ABMR(10,150)=""
  1.  S ABMR(10,150)=$$FMT^ABMERUTL(ABMR(10,150),15)
  1.  Q
  1. 160 ;135-149 Other Insurer Provider Number 1
  1.  S ABMR(10,160)=""
  1.  S ABMR(10,160)=$$FMT^ABMERUTL(ABMR(10,160),15)
  1.  Q
  1. 170 ;Other Insurer Provider Number 2
  1.  S ABMR(10,170)=""
  1.  S ABMR(10,170)=$$FMT^ABMERUTL(ABMR(10,170),15)
  1.  Q
  1. 180 ;165-197 Organization Name
  1.  D DIQ2
  1.  S ABMR(10,180)=ABM(9002274.5,1,.26,"E")
  1.  S:ABMR(10,180)="" ABMR(10,180)=$P(^AUTTLOC(DUZ(2),0),"^",2)
  1.  S ABMR(10,180)=$$FMT^ABMERUTL(ABMR(10,180),33)
  1.  Q
  1. 190 ;198-217 Provider Last Name
  1.  S ABMR(10,190)=$$LNM^ABMEEPRV(ABMAPRV)
  1.  S ABMR(10,190)=$$FMT^ABMERUTL(ABMR(10,190),20)
  1.  Q
  1. 200 ;218-229 Provider First Name
  1.  S ABMR(10,200)=$$FNM^ABMEEPRV(ABMAPRV)
  1.  S ABMR(10,200)=$$FMT^ABMERUTL(ABMR(10,200),12)
  1.  Q
  1. 210 ;230-230 Provider MI
  1.  S ABMR(10,210)=$$MI^ABMEEPRV(ABMAPRV)
  1.  S ABMR(10,210)=$$FMT^ABMERUTL(ABMR(10,210),1)
  1.  Q
  1. 220 ;231-233 Provider Specialty
  1.  ; ABM*2.4*9 IHS/FCS/DRS 09/21/01 ; Part 4b - call $$ENVSPEC instead of $$SPEC, 
  1.  S ABMR(10,220)=$$ENVSPEC^ABMEEPRV(ABMAPRV)
  1.  S ABMR(10,220)=$$FMT^ABMERUTL(ABMR(10,220),3)
  1.  Q
  1. 230 ;234-248 Specialty License Number
  1.  S ABMR(10,230)=""
  1.  S ABMR(10,230)=$$FMT^ABMERUTL(ABMR(10,230),15)
  1.  Q
  1. 240 ;249-263 State License Number
  1.  S ABMR(10,240)=$$SLN^ABMEEPRV(ABMAPRV)
  1.  S ABMR(10,240)=$$FMT^ABMERUTL(ABMR(10,240),15)
  1.  Q
  1. 250 ;264-278 Dentist License Number
  1.  S ABMR(10,250)=""
  1.  S ABMR(10,250)=$$FMT^ABMERUTL(ABMR(10,250),15)
  1.  Q
  1. 260 ;279-293 Anesthesia License Number
  1.  S ABMR(10,260)=""
  1.  S ABMR(10,260)=$$FMT^ABMERUTL(ABMR(10,260),15)
  1.  Q
  1. 270 ;294-306 Filler (National Use)
  1.  S ABMR(10,270)=""
  1.  S ABMR(10,270)=$$FMT^ABMERUTL(ABMR(10,270),13)
  1.  Q
  1. 280 ;307-320 Filler (Local Use)
  1.  S ABMR(10,280)=""
  1.  S ABMR(10,280)=$$FMT^ABMERUTL(ABMR(10,280),14)
  1.  Q
  1. DIQ1 ;PULL LOCATION DATA VIA DIQ1
  1.  Q:$D(ABM(9999999.06,ABMP("LDFN")))
  1.  N I
  1.  S DIQ="ABM("
  1.  S DIQ(0)="IE"
  1.  S DIC="^AUTTLOC("
  1.  S DA=ABMP("LDFN")
  1.  S DR=".01;.21;.22"
  1.  D EN^DIQ1
  1.  S ABMP("PAYDFN")=$P($G(^ABMDPARM(DUZ(2),1,2)),"^",3)
  1.  S:'$D(^AUTTLOC(+ABMP("PAYDFN"),0)) ABMP("PAYDFN")=ABMP("LDFN")
  1.  S DA=ABMP("PAYDFN")
  1.  S DR=".13;.14;.15;.16;.17;.21"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1.  ;
  1. DIQ2 ;GET SITE PARAMETER INFO    
  1.  Q:$D(ABM(9002274.5,DUZ(2)))
  1.  N I
  1.  S DIQ="ABM("
  1.  S DIQ(0)="E"
  1.  S DIC="^ABMDPARM(DUZ(2),"
  1.  S DA=1
  1.  S DR=.26
  1.  D EN^DIQ1 K DIQ
  1.  Q
  1.  ;
  1. EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
  1.  ;
  1.  ;  INPUT:  ABMX = data element
  1.  ;             Y = bill internal entry number
  1.  ;
  1.  ; OUTPUT:     Y = bill internal entry number
  1.  ;
  1.  S ABMP("BDFN")=ABMY
  1.  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