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

ABMER31.m

Go to the documentation of this file. 
  1. ABMER31 ; IHS/ASDST/DMJ - UB92 EMC RECORD 31 (Third Party Payor Address) ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;DMJ;08/18/95 10:38 AM
  1.  ;
  1.  ; ABM*2.4*9 IHS/FCS/DRS 09/21/01
  1.  ; IHS/FCS/DRS 09/17/01 Part 11 - fix to Insured's State
  1.  ;
  1. START ;START HERE
  1.  K ABMR(31),ABMREC(31,ABME("S#"))
  1.  S ABME("RTYPE")=31       ; Record type
  1.  D SET^ABMERUTL,LOOP
  1.  D S90^ABMERUTL           ; Increment record type counter
  1.  Q
  1.  ;
  1. LOOP ;LOOP HERE
  1.  F I=10:10:150 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),31,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(31,ABME("S#"))=$G(ABMREC(31,ABME("S#")))_ABMR(31,I)
  1.  Q
  1.  ;
  1. 10 ;EP - Record type
  1.  S ABMR(31,10)=31
  1.  Q
  1.  ;
  1. 20 ;EP - Payor Priority (SOURCE: FILE=9002274.4013, FIELD=.02)
  1.  S ABMR(31,20)="0"_ABME("S#")
  1.  S ABMR(31,20)=$$FMT^ABMERUTL(ABMR(31,20),2)
  1.  Q
  1.  ;
  1. 30 ;EP - Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
  1.  S ABMR(31,30)=$$EX^ABMER20(30,ABMP("BDFN"))
  1.  S ABMR(31,30)=$$FMT^ABMERUTL(ABMR(31,30),20)
  1.  Q
  1.  ;
  1. 40 ;EP - Insured's Address Line 1 (SOURCE: FILE=2 or 9000003.1 FIELD=)
  1.  S ABMR(31,40)=""
  1.  I $G(ABME("PPP")) D               ; from patient file
  1.  .S ABME("FLD")=.111
  1.  .D DIQ4^ABMER31A
  1.  .S ABMR(31,40)=$G(ABM(2,ABME("PPP"),.111,"E"))
  1.  I ABMR(31,40)="",$G(ABME("PH")) D  ; else policy holder file
  1.  .S ABME("FLD")=.09
  1.  .D DIQ1^ABMER31A
  1.  .S ABMR(31,40)=$G(ABM(9000003.1,+ABME("PH"),.09,"E"))
  1.  S ABMR(31,40)=$$FMT^ABMERUTL(ABMR(31,40),18)
  1.  Q
  1.  ;
  1. 50 ;EP - Insured's Address Line 2 (SOURCE: FILE= FIELD=)
  1.  S ABMR(31,50)=""
  1.  I $G(ABME("PPP")) D
  1.  .S ABME("FLD")=.112
  1.  .D DIQ4^ABMER31A
  1.  .S ABMR(31,50)=$G(ABM(2,ABME("PPP"),.112,"E"))
  1.  S ABMR(31,50)=$$FMT^ABMERUTL(ABMR(31,50),18)
  1.  Q
  1.  ;
  1. 60 ;EP - Insured's City (SOURCE: FILE=, FIELD=)
  1.  S ABMR(31,60)=""
  1.  I $G(ABME("PPP")) D
  1.  .S ABME("FLD")=.114
  1.  .D DIQ4^ABMER31A
  1.  .S ABMR(31,60)=$G(ABM(2,ABME("PPP"),.114,"E"))
  1.  I ABMR(31,60)="",$G(ABME("PH")) D
  1.  .S ABME("FLD")=.11
  1.  .D DIQ1^ABMER31A
  1.  .S ABMR(31,60)=$G(ABM(9000003.1,+ABME("PH"),.11,"E"))
  1.  S ABMR(31,60)=$$FMT^ABMERUTL(ABMR(31,60),15)
  1.  Q
  1.  ;
  1. 70 ;EP - Insured's State (SOURCE: FILE=, FIELD=)
  1.  S ABMR(31,70)=""
  1.  S ABME("ISTATE")=""
  1.  I $G(ABME("PPP")) D
  1.  .S ABME("FLD")=.115
  1.  .D DIQ4^ABMER31A
  1.  .S ABME("ISTATE")=$G(ABM(2,ABME("PPP"),.115,"I"))
  1.  I 'ABME("ISTATE"),$G(ABME("PH")) D
  1.  .S ABME("FLD")=.12
  1.  .D DIQ1^ABMER31A
  1.  .S ABME("ISTATE")=$G(ABM(9000003.1,ABME("PH"),.12,"I"))
  1.  S ABMR(31,70)=$P($G(^DIC(5,+ABME("ISTATE"),0)),"^",2)
  1.  S ABMR(31,70)=$$FMT^ABMERUTL(ABMR(31,70),2)
  1.  Q
  1.  ;
  1. 80 ;EP - Insured's Zip (SOURCE: FILE=9999999.18, FIELD=.01)
  1.  S ABMR(31,80)=""
  1.  I $G(ABME("PPP")) D
  1.  .S ABME("FLD")=.116
  1.  .D DIQ4^ABMER31A
  1.  .S ABMR(31,80)=$G(ABM(2,ABME("PPP"),.116,"E"))
  1.  I ABMR(31,80)="",$G(ABME("PH")) D
  1.  .S ABME("FLD")=.13
  1.  .D DIQ1^ABMER31A
  1.  .S ABMR(31,80)=$G(ABM(9000003.1,ABME("PH"),.13,"E"))
  1.  S $E(ABMR(31,80),6,9)="0000"
  1.  S ABMR(31,80)=$$FMT^ABMERUTL(ABMR(31,80),9)
  1.  Q
  1.  ;
  1. 90 ;EP - Employer Name (SOURCE: FILE=9999999.75, FIELD=.01)
  1.  S ABMR(31,90)=""
  1.  I $G(ABME("PPP")) D
  1.  .S ABME("FLD")=.01
  1.  .D DIQ3^ABMER31A
  1.  .S ABMR(31,90)=$G(ABM(9999999.75,+DA,.01,"E"))
  1.  I ABMR(31,90)="",$G(ABME("PH")) D
  1.  .S ABME("FLD")=.16
  1.  .D DIQ1^ABMER31A
  1.  .S ABMR(31,90)=$G(ABM(9000003.1,ABME("PH"),.16,"E"))
  1.  S ABMR(31,90)=$$FMT^ABMERUTL(ABMR(31,90),24)
  1.  Q
  1.  ;
  1. 100 ;EP - Employer Address (SOURCE: FILE=9999999.75, FIELD=.02)
  1.  S ABMR(31,100)=""
  1.  I $G(ABME("PPP")) D
  1.  .S ABME("FLD")=.02
  1.  .D DIQ3^ABMER31A
  1.  .S ABMR(31,100)=$G(ABM(9999999.75,+DA,.02,"E"))
  1.  I ABMR(31,100)="",$G(ABME("PH")) D
  1.  .S ABME("FLD")=.021
  1.  .D DIQ2^ABMER31A
  1.  .S ABMR(31,100)=$G(ABM(9999999.75,+ABME("EMP"),.02,"E"))
  1.  S ABMR(31,100)=$$FMT^ABMERUTL(ABMR(31,100),18)
  1.  Q
  1.  ;
  1. 110 ;EP - Employer City (SOURCE: FILE=9999999.75, FIELD=.03)
  1.  ; form locator #66
  1.  S ABMR(31,110)=""
  1.  I $G(ABME("PPP")) D
  1.  .S ABME("FLD")=.03
  1.  .D DIQ3^ABMER31A
  1.  .S ABMR(31,110)=$G(ABM(9999999.75,+DA,.03,"E"))
  1.  I ABMR(31,110)="",$G(ABME("PH")) D
  1.  .S ABME("FLD")=.03
  1.  .D DIQ2^ABMER31A
  1.  .S ABMR(31,110)=$G(ABM(9999999.75,+ABME("EMP"),.03,"E"))
  1.  S ABMR(31,110)=$$FMT^ABMERUTL(ABMR(31,110),15)
  1.  Q
  1.  ;
  1. 120 ;EP - Employer State (SOURCE: FILE=9999999.75, FIELD=.04)     
  1.  ; form locator #66
  1.  I $G(ABME("PPP")) D
  1.  .S ABME("FLD")=.04
  1.  .D DIQ3^ABMER31A
  1.  .S ABME("ESTATE")=$G(ABM(9999999.75,+DA,.04,"I"))
  1.  I '$G(ABME("ESTATE")),$G(ABME("PH")) D
  1.  .S ABME("FLD")=.04
  1.  .D DIQ2^ABMER31A
  1.  .S ABME("ESTATE")=$G(ABM(9999999.75,+ABME("EMP"),.04,"I"))
  1.  S ABMR(31,120)=$S($G(ABME("ESTATE")):$P($G(^DIC(5,ABME("ESTATE"),0)),"^",2),1:"")
  1.  S ABMR(31,120)=$$FMT^ABMERUTL(ABMR(31,120),2)
  1.  Q
  1.  ;
  1. 130 ;EP - Employer Zip (SOURCE: FILE=9999999.75, FIELD=.05)
  1.  S ABMR(31,130)=""
  1.  I $G(ABME("PPP")) D
  1.  .S ABME("FLD")=.05
  1.  .D DIQ3^ABMER31A
  1.  .S ABMR(31,130)=$G(ABM(9999999.75,+DA,.05,"E"))
  1.  I ABMR(31,130)="",$G(ABME("PH")) D
  1.  .S ABME("FLD")=.05
  1.  .D DIQ2^ABMER31A
  1.  .S ABMR(31,130)=$G(ABM(9999999.75,+ABME("EMP"),.05,"E"))
  1.  S ABMR(31,130)=$$FMT^ABMERUTL(ABMR(31,130),9)
  1.  Q
  1.  ;
  1. 140 ;EP - Form Locator 37 (ICN/DCN) (SOURCE: FILE=, FIELD=)
  1.  S ABMR(31,140)=""
  1.  S ABMR(31,140)=$$FMT^ABMERUTL(ABMR(31,140),23)
  1.  Q
  1.  ;
  1. 150 ;EP - Filler (National Use)
  1.  S ABMR(31,150)=""
  1.  S ABMR(31,150)=$$FMT^ABMERUTL(ABMR(31,150),15)
  1.  Q
  1.  ;
  1. EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
  1.  ;
  1.  ;  INPUT:  ABMX = data element
  1.  ;          ABMY = bill internal entry number
  1.  ;          ABMZ = Insurer priority (1 thru 3)
  1.  ;
  1.  ; OUTPUT:     Y = bill internal entry number
  1.  ;
  1.  S ABMP("BDFN")=ABMY
  1.  D SET^ABMERUTL
  1.  S ABME("INS")=ABMZ
  1.  I '$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABME("INS"))) S Y="" Q Y
  1.  D ISET^ABMERINS
  1.  I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
  1.  D @ABMX
  1.  S Y=ABMR(31,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(31,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
  1.  Q Y