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

ABMER10.m

Go to the documentation of this file. 
  1. ABMER10 ; IHS/ASDST/DMJ - UB92 EMC RECORD 10 (Provider) ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
  1.  ;Original;DMJ;08/15/96 12:03 PM
  1.  ;
  1.  ; IHS/DSD/LSL - 09/14/98 - Patch 2 - NOIS XXX-0698-200039
  1.  ;               AHCCCS needs leading zeroes on Medicaid Provider number
  1.  ; IHS/ASDS/DMJ - 04/18/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
  1.  ;     Modified location code to check for satellite first.  If no
  1.  ;     satellite use parent.
  1.  ; IHS/ASDS/LSL - 08/29/00 - V2.4 Patch 3 - NOIS QDA-0800-130111
  1.  ;     Populate medicaid provider number if kidscare
  1.  ; IHS/FCS/DRS - 09/17/01 - V2.4 Patch 9
  1.  ;     Part 20 - Field 10-13 Provider Address - remove illegal chars
  1.  ;
  1.  ; IHS/SD/SDR - 10/29/02 - V2.5 P2 - BXX-0501-150089
  1.  ;     Modified routine to shorted 2nd line of address by 2 so bill
  1.  ;     type won't be cut off on right margin.
  1.  ;
  1. START ;START HERE
  1.  K ABMREC(10),ABMR(10)
  1.  S ABME("RTYPE")=10
  1.  D LOOP
  1.  K ABME,ABM
  1.  Q
  1.  ;
  1. LOOP ;LOOP HERE
  1.  F I=10:10:200 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)="10"
  1.  Q
  1.  ;
  1. 20 ;Type of Batch (SOURCE: FILE=9002274.4, FIELD=.02)
  1.  S ABMR(10,20)=ABMP("BTYP")
  1.  S ABMR(10,20)=$$FMT^ABMERUTL(ABMR(10,20),3)
  1.  Q
  1.  ;
  1. 30 ;Batch Number
  1.  S ABMR(10,30)=ABMEF("BATCH#")
  1.  S ABMR(10,30)=$$FMT^ABMERUTL(ABMR(10,30),"2NR")
  1.  Q
  1.  ;
  1. 40 ; EP
  1.  ; Federal Tax Number or EIN (SOURCE: FILE=9999999.06, FIELD=.21)
  1.  ; 2/10/98 - LSL - Use Fed Tax Number of facility providing service
  1.  ;           not facility receiving payment. Per Santa Fe.
  1.  ; form locator #5
  1.  D DIQ1
  1.  S ABMR(10,40)=ABM(9999999.06,ABMP("LDFN"),.21,"E")
  1.  I $$RCID^ABMERUTL(ABMP("INS"))=99999 D
  1.  .S ABMR(10,40)=$$FMT^ABMERUTL(ABMR(10,40),10)
  1.  I $$RCID^ABMERUTL(ABMP("INS"))'=99999 D
  1.  .S ABMR(10,40)=$$FMT^ABMERUTL(ABMR(10,40),"10NR")
  1.  ;abm*2.6*11 IHS/SD/AML 7/1/13 - BEGIN NEW CODE - Uses new Tax ID for VA Billing only
  1.  I $P($G(^AUTNINS(ABMP("INS"),0)),U)["VMBP"  D
  1.  .I DUZ(2)=2248 S ABMR(10,40)="364587378"  ;Crow Hospital
  1.  .I DUZ(2)=2299 S ABMR(10,40)="371522894"  ;Fort Belknap
  1.  .I DUZ(2)=2311 S ABMR(10,40)="364587381"  ;Fort Peck
  1.  .I DUZ(2)=2348 S ABMR(10,40)="364587379"  ;Lame Deer
  1.  .I DUZ(2)=2336 S ABMR(10,40)="364587384"  ;Fort Washakie
  1.  ;abm*2.6*11 IHS/SD/AML 7/1/13 - END NEW CODE - Uses new Tax ID for VA Billing only
  1.  S ABMRT(95,20)=ABMR(10,40)
  1.  Q
  1.  ;
  1. 50 ;Federal Tax Submitter ID (SOURCE: FILE=, FIELD=)
  1.  S ABMR(10,50)=""
  1.  S ABMR(10,50)=$$FMT^ABMERUTL(ABMR(10,50),4)
  1.  Q
  1.  ;
  1. 60 ;Medicare Provider Number (SOURCE: FILE=9999999.181501, FIELD=.02)
  1.  S ABMR(10,60)=""
  1.  I ABMP("ITYPE")="R" D
  1.  .S ABMR(10,60)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,8)
  1.  .S:ABMR(10,60)="" ABMR(10,60)=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),"^",2)
  1.  .I ABMR(10,60)="" D
  1.  ..D DIQ1
  1.  ..S ABMR(10,60)=ABM(9999999.06,ABMP("LDFN"),.22,"E")
  1.  ..Q
  1.  .S ABMR(10,60)=$TR(ABMR(10,60),"-")
  1.  S ABMR(10,60)=$$FMT^ABMERUTL(ABMR(10,60),13)
  1.  Q
  1.  ;
  1. 70 ;Medicaid Provider Number (SOURCE: FILE=9999999.181501, FIELD=.02)
  1.  S ABMR(10,70)=""
  1.  I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D
  1.  .S ABMR(10,70)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,8)
  1.  .S:ABMR(10,70)="" ABMR(10,70)=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),"^",2)
  1.  S:$$RCID^ABMERUTL(ABMP("INS"))=99999 ABMR(10,70)="OO"_ABMR(10,70)
  1.  S ABMR(10,70)=$$FMT^ABMERUTL(ABMR(10,70),13)
  1.  Q
  1.  ;
  1. 80 ; Champus Insurer Provider Number
  1.  ; (SOURCE: FILE=9999999.181501, FIELD=.02)
  1.  S ABMR(10,80)=""
  1.  S ABMR(10,80)=$$FMT^ABMERUTL(ABMR(10,80),13)
  1.  Q
  1.  ;
  1. 90 ; Other Insurer Provider Number 1
  1.  ; (SOURCE: FILE=9999999.181501, FIELD=.02)
  1.  S ABMR(10,90)=""
  1.  I $G(ABMP("BCBS")) D
  1.  .D DIQ1
  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(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),"^",2)
  1.  .S ABMR(10,90)=ABMR(10,90)_" "_$E(ABM(9999999.06,ABMP("LDFN"),.01,"E"),1,2)
  1.  S ABMR(10,90)=$$FMT^ABMERUTL(ABMR(10,90),13)
  1.  Q
  1.  ;
  1. 100 ;Other Insurer Provider Number 2 (SOURCE: FILE=9999999.18, FIELD=)
  1.  S ABMR(10,100)=""
  1.  S ABMR(10,100)=$$FMT^ABMERUTL(ABMR(10,100),13)
  1.  Q
  1.  ;
  1. 110 ; EP
  1.  ; Provider Telephone Number (SOURCE: FILE=9999999.06 FIELD=.13)
  1.  ; Form locator #1
  1.  D DIQ1
  1.  S ABMR(10,110)=ABM(9999999.06,ABMP("PAYDFN"),.13,"E")
  1.  I '$G(ABMP("NOFMT")) S ABMR(10,110)=$TR(ABMR(10,110),"() -")
  1.  S ABMR(10,110)=$$FMT^ABMERUTL(ABMR(10,110),"10R")
  1.  Q
  1.  ;
  1. 120 ; EP
  1.  ; Provider Name (SOURCE: FILE=9002274.5, FIELD=.26)
  1.  ; Form locator #1
  1.  D DIQ2
  1.  S ABMR(10,120)=ABM(9002274.5,1,.26,"E")
  1.  S:ABMR(10,120)="" ABMR(10,120)=$P(^AUTTLOC(DUZ(2),0),"^",2)
  1.  S ABMR(10,120)=$$FMT^ABMERUTL(ABMR(10,120),25)
  1.  Q
  1.  ;
  1. 130 ; EP
  1.  ; Provider Address (SOURCE: FILE=9999999.06, FIELD=9999999.06,.14)
  1.  ; Form locator #1
  1.  D DIQ1
  1.  S ABMR(10,130)=ABM(9999999.06,ABMP("PAYDFN"),.14,"E")
  1.  I $$ENVOY^ABMEF16 D
  1.  .S ABMR(10,130)=$$REPLNOT(ABMR(10,130),"/,. &#")
  1.  S ABMR(10,130)=$$FMT^ABMERUTL(ABMR(10,130),23)
  1.  Q
  1. REPLNOT(X,P) ; EP - replace punctuation not in P in X with spaces ; return the result ; P is the punctuation you want to protect ; replaces control chars too
  1.  N I F I=1:1:$L(X) I $E(X,I)?1PC,P'[$E(X,I) S $E(X,I)=" "
  1.  Q X
  1.  ;
  1. 140 ; EP
  1.  ; Provider City (SOURCE: FILE=9999999.06, FIELD=.15)
  1.  ; Form locator #1
  1.  D DIQ1
  1.  S ABMR(10,140)=ABM(9999999.06,ABMP("PAYDFN"),.15,"E")
  1.  S ABMR(10,140)=$$FMT^ABMERUTL(ABMR(10,140),14)
  1.  Q
  1.  ;
  1. 150 ; EP
  1.  ; Provider State (SOURCE: FILE=9999999.06 FIELD=.16)
  1.  ; Form locator #1
  1.  D DIQ1
  1.  S ABMR(10,150)=$P($G(^DIC(5,ABM(9999999.06,ABMP("PAYDFN"),.16,"I"),0)),"^",2)
  1.  S ABMR(10,150)=$$FMT^ABMERUTL(ABMR(10,150),2)
  1.  Q
  1.  ;
  1. 160 ; EP
  1.  ; Provider Zip (SOURCE: FILE=9999999.06, FIELD=.17)
  1.  ; Form locator #1
  1.  D DIQ1
  1.  S ABMR(10,160)=ABM(9999999.06,ABMP("PAYDFN"),.17,"E")
  1.  I '$G(ABMP("NOFMT")) S $E(ABMR(10,160),6,9)="0000"
  1.  S ABMR(10,160)=$$FMT^ABMERUTL(ABMR(10,160),9)
  1.  Q
  1.  ;
  1. 170 ;Provider FAX Number (SOURCE: FILE= FIELD=)
  1.  S ABMR(10,170)=""
  1.  S ABMR(10,170)=$$FMT^ABMERUTL(ABMR(10,170),"10NR")
  1.  Q
  1.  ;
  1. 180 ;Country Code (SOURCE: FILE=, FIELD=)     
  1.  S ABMR(10,180)=""
  1.  S ABMR(10,180)=$$FMT^ABMERUTL(ABMR(10,180),4)
  1.  Q
  1.  ;
  1. 190 ;Filler (National Use)
  1.  S ABMR(10,190)=""
  1.  S ABMR(10,190)=$$FMT^ABMERUTL(ABMR(10,190),4)
  1.  Q
  1.  ;
  1. 200 ;Filler (Local Use)
  1.  S ABMR(10,200)=""
  1.  S ABMR(10,200)=$$FMT^ABMERUTL(ABMR(10,200),3)
  1.  Q
  1.  ;
  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