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

ABMER30A.m

Go to the documentation of this file. 
  1. ABMER30A ; IHS/ASDST/DMJ - UB92 EMC RECORD 30 (Third Party Payor) cont'd ;   
  1.  ;;2.6;IHS Third Party Billing System;**3**;NOV 12, 2009
  1.  ;Original;DMJ;04/12/96 3:31 PM
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM19557 - Patient name if Non-Ben
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20225 - Check for DME group number
  1.  ; IHS/SD/SDR - abm*2.6*3 - HEAT8996 - get group number for Medicaid
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. LOOP2 ;LOOP HERE
  1.  F I=10:10:150 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),30,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(30,ABME("S#"))=$G(ABMREC(30,ABME("S#")))_ABMR(30,I)
  1.  Q
  1.  ;
  1. 10 ;Record type
  1.  S ABMR(30,10)=30
  1.  Q
  1.  ;
  1. 20 ;Payor Priority (SOURCE: FILE=9002274.4013, FIELD=.02)
  1.  S ABMR(30,20)="0"_ABME("S#")
  1.  S ABMR(30,20)=$$FMT^ABMERUTL(ABMR(30,20),2)
  1.  Q
  1.  ;
  1. 30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
  1.  S ABMR(30,30)=$$EX^ABMER20(30,ABMP("BDFN"))
  1.  S ABMR(30,30)=$$FMT^ABMERUTL(ABMR(30,30),20)
  1.  Q
  1.  ;
  1. 40 ;Source Payment Code (SOURCE: FILE=9999999.18, FIELD=.21)
  1.  S ABMR(30,40)=$S(ABME("ITYPE")="W":"B",ABME("ITYPE")="R":"C",ABME("ITYPE")="D"!(ABME("ITYPE")="K"):"D",$G(ABME("BCBS")):"G",ABME("ITYPE")="P":"F",1:"H")
  1.  Q
  1.  ;
  1. 50 ;Receiver Identification (SOURCE: FILE=9999999.18, FIELD=.08)
  1.  S ABMR(30,50)=$$RCID^ABMERUTL(ABME("INS"))
  1.  S:$$ENVOY^ABMEF16 ABMR(30,50)=$$ENVY^ABMERUTL(ABME("INS"),"H")
  1.  S ABMR(30,50)=$$FMT^ABMERUTL(ABMR(30,50),5)
  1.  Q
  1.  ;         
  1. 60 ;Receiver Sub Identification (SOURCE: FILE=, FIELD=)
  1.  ; form locator 51
  1.  S ABMR(30,60)=$G(ABMR(30,60))
  1.  S ABMR(30,60)=$$FMT^ABMERUTL(ABMR(30,60),"4R")
  1.  Q
  1.  ;
  1. 70 ;Claim Certificate ID Number (SOURCE: FILE=, FIELD=)
  1.  ; form locator 60
  1.  ; (previously set in ^ABMERINS)
  1.  S ABMR(30,70)=$G(ABMR(30,70))
  1.  S ABMR(30,70)=$$FMT^ABMERUTL(ABMR(30,70),19)
  1.  Q
  1.  ;
  1. 80 ;Insurance Company Name (SOURCE: FILE=9999999.18, FIELD=.01)
  1.  ; form locator 50
  1.  S ABMR(30,80)=$P(^AUTNINS(ABME("INS"),0),U)
  1.  I ABME("ITYPE")="D"!(ABME("ITYPE")="K") D
  1.  .Q:ABMR(30,80)'["NEW MEXICO"
  1.  .Q:ABMR(30,80)'["MEDICAID"
  1.  .S ABMR(30,80)="MEDICAID"
  1.  I ABME("ITYPE")="N" S ABMR(30,80)=ABMP("PNAME")
  1.  S ABMR(30,80)=$$FMT^ABMERUTL(ABMR(30,80),25)
  1.  Q
  1.  ;
  1. 90 ;Payer Code (SOURCE: FILE=, FIELD=)
  1.  S ABMR(30,90)=$S(ABME("ITYPE")="R":"Z",ABME("ITYPE")="W":"E",ABME("ITYPE")="D"!(ABME("ITYPE")="K"):1,$G(ABME("BCBS")):2,1:3)
  1.  Q
  1.  ;
  1. 100 ;Group ID Number (SOURCE: FILE=9999999.77, FIELD=.02)
  1.  ; form locator 62
  1.  S ABMR(30,100)=$P($G(^AUTNEGRP(+$G(ABME("GRP")),0)),"^",2)
  1.  S ABMR(30,100)=$$FMT^ABMERUTL(ABMR(30,100),17)
  1.  Q
  1.  ;
  1. 110 ;Group Name (SOURCE: FILE=9999999.77, FIELD=.01)
  1.  ; form locator 61
  1.  S ABMR(30,110)=$P($G(^ABMNINS(DUZ(2),ABME("INS"),1,ABMP("VTYP"),1)),U,3)
  1.  I $G(ABMR(30,110))="" D
  1.  .S ABMR(30,110)=$G(ABM(9000003.1,+$G(ABME("PH")),.06,"E"))
  1.  .I ABMR(30,110)="",ABME("ITYPE")="P" S ABMR(30,110)="UNKNOWN"
  1.  .I ABMR(30,110)="",ABME("ITYPE")="D",$G(ABME("GRP")) S ABMR(30,110)=$P($G(^AUTNEGRP(ABME("GRP"),0)),U)  ;abm*2.6*3 HEAT8996
  1.  S ABMR(30,110)=$$FMT^ABMERUTL(ABMR(30,110),14)
  1.  Q
  1.  ;
  1. 120 ;Insured's Last Name (SOURCE: FILE=, FIELD=)     
  1.  ; form locator 58
  1.  S ABMR(30,120)=$P(ABME("PHNM"),",",1)
  1.  S ABMR(30,120)=$$FMT^ABMERUTL(ABMR(30,120),20)
  1.  Q
  1.  ;
  1. 130 ;Insured's First Name (SOURCE: FILE=, FIELD=)
  1.  ; form locator 58
  1.  S ABMR(30,130)=$P(ABME("PHNM"),",",2),ABMR(30,130)=$P(ABMR(30,130)," ",1)
  1.  S ABMR(30,130)=$$FMT^ABMERUTL(ABMR(30,130),9)
  1.  Q
  1.  ;
  1. 140 ;Insured's Middle Initial (SOURCE: FILE=, FIELD=)
  1.  ; form locator 58
  1.  S ABMR(30,140)=$P(ABME("PHNM"),",",2)
  1.  S ABMR(30,140)=$P(ABMR(30,140)," ",2)
  1.  S ABMR(30,140)=$E(ABMR(30,140))
  1.  S ABMR(30,140)=$$FMT^ABMERUTL(ABMR(30,140),1)
  1.  Q
  1.  ;
  1. 150 ;Insured's Sex (SOURCE: FILE=, FIELD=)
  1.  I $G(ABME("PHSEX")) S ABMR(30,150)=ABME("PHSEX")
  1.  E  S ABMR(30,150)=$$EX^ABMER20A(70,ABMP("BDFN"))
  1.  S ABMR(30,150)=$$FMT^ABMERUTL(ABMR(30,150),1)
  1.  Q
  1.  ;
  1. DIQ1 ;PULL BILL DATA VIA DIQ1
  1.  Q:$D(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
  1.  N I
  1.  S DIQ="ABM("
  1.  S DIQ(0)="EI"
  1.  S DIC="^ABMDBILL(DUZ(2),"
  1.  S DA=ABMP("BDFN")
  1.  S DR=".66;.67;.68;.73;.74;.75;.99"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1.  ;
  1. DIQ2 ;POLICY HOLDER INFORMATION
  1.  Q:'$G(ABME("PH"))
  1.  Q:$D(ABM(9000003.1,ABME("PH"),ABME("FLD")))
  1.  N I
  1.  S DIQ="ABM("
  1.  S DIQ(0)="EI"
  1.  S DIC="^AUPN3PPH("
  1.  S DA=ABME("PH")
  1.  S DR=".02;.15"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1.  ;
  1. DIQ3 ;PATIENT IS INSURED    
  1.  Q:$D(ABM(2,ABMP("PDFN"),ABME("FLD")))
  1.  N I
  1.  S DIQ="ABM("
  1.  S DIQ(0)="EI"
  1.  S DIC="^DPT("
  1.  S DA=ABMP("PDFN")
  1.  S DR=".31115"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1.  ;
  1. EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNTION HERE
  1.  ;
  1.  ;  INPUT:  ABMX = data element
  1.  ;          ABMY = bill internal entry number
  1.  ;          ABMZ = insurer
  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.  S ABME("S#")=0
  1.  D ISET^ABMERINS
  1.  I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
  1.  D @ABMX
  1.  S Y=ABMR(30,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(30,ABMX),ABMX,ABMY,ABME,ABM
  1.  Q Y