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

ABMEH30.m

Go to the documentation of this file. 
  1. ABMEH30 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD 30 (Third Party Payor) ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/ASDS/LSL - 06/23/00 - V2.4 Patch 2 - NOIS XAA-0600-200082
  1.  ;     Modified to kill old data before creating new DA2 record
  1.  ;
  1.  ; IHS/FCS/DRS - 09/17/01 - V2.4 Patch 9
  1.  ;     Part 14d - Payer ID in DA0.7
  1.  ;
  1. START ;START HERE
  1.  K ABMREC(30),ABMREC(31),ABMREC(32),ABME,ABM
  1.  K ABMP("SET")
  1.  D SET^ABMERUTL,LOOP  ; get insurer data
  1.  K ABME,ABM
  1.  Q
  1.  ;
  1. LOOP ;FIRST LOOP
  1.  ; Loop thru INS priorities
  1.  S ABME("S#")=0
  1.  F  S ABME("S#")=$O(ABMP("INS",ABME("S#"))) Q:'ABME("S#")  D
  1.  .S ABME("INS")=+ABMP("INS",ABME("S#"))  ; Insurer IEN
  1.  .S ABME("INSIEN")=$P(ABMP("INS",ABME("S#")),"^",3)  ; IEN to insurer multiple
  1.  .S ABME("RTYPE")=30    ; record type
  1.  .K ABMR(30),ABMR(31),ABMR(32)
  1.  .D ISET^ABMERINS       ; set INS priority
  1.  .D LOOP2               ; Get data
  1.  .D S90^ABMERUTL        ; Add 1 to record type counts (electronic)
  1.  .D ^ABMEH31
  1.  .D ^ABMEH32
  1.  Q
  1.  ;
  1. LOOP2 ;LOOP HERE
  1.  F I=10:10:300 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. 10 ;1-3 Record ID
  1.  S ABMR(30,10)="DA0"
  1.  Q
  1. 20 ;4-5 Sequence #
  1.  S ABMR(30,20)=ABME("S#")
  1.  S ABMR(30,20)=$$FMT^ABMERUTL(ABMR(30,20),"2NR")
  1.  Q
  1. 30 ;6-22 Patient Control Number
  1.  S ABMR(30,30)=ABMP("PCN")
  1.  S ABMR(30,30)=$$FMT^ABMERUTL(ABMR(30,30),17)
  1.  Q
  1. 40 ;23-23 Claim Filing Indicator
  1.  S ABMR(30,40)="I"
  1.  S:ABME("INS")=ABMP("INS") ABMR(30,40)="P"
  1.  Q
  1. 50 ;24-24 Source of Pay
  1.  S ABMR(30,50)=ABMP("SOP")
  1.  Q
  1. 60 ;25-26 Insurance Type Code
  1.  S ABMR(30,60)="IP"
  1.  Q
  1. 70 ;27-31 Payor Organization ID
  1.  ; ABM*2.4*9 IHS/FCS/DRS 09/21/01 ; Part 14d - Give priority to Envoy ID
  1.  ; And if it's not there, fall back to $P(^AUTNINS(D0,0),U,8)
  1.  S ABMR(30,70)=""
  1.  I $$ENVOY^ABMEF19 D
  1.  .S ABMR(30,70)=$$ENVY^ABMERUTL(ABME("INS"),ABMP("VTYP"))
  1.  I ABMR(30,70)="" S ABMR(30,70)=$$RCID^ABMERUTL(ABME("INS"))
  1.  S ABMR(30,70)=$$FMT^ABMERUTL(ABMR(30,70),5)
  1.  Q
  1. 80 ;32-35 Payor Claim Office #
  1.  S ABMR(30,80)=""
  1.  S ABMR(30,80)=$$FMT^ABMERUTL(ABMR(30,80),4)
  1.  Q
  1. 90 ;36-68 Payor Name
  1.  S ABMR(30,90)=$P(^AUTNINS(ABME("INS"),0),U)
  1.  S ABMR(30,90)=$$FMT^ABMERUTL(ABMR(30,90),33)
  1.  Q
  1. 100 ;69-88 Group #
  1.  S ABMR(30,100)=$P($G(^AUTNEGRP(+$G(ABME("GRP")),0)),"^",2)
  1.  S ABMR(30,100)=$$FMT^ABMERUTL(ABMR(30,100),20)
  1.  Q
  1. 110 ;89-121 Group Name
  1.  S ABMR(30,110)=$G(ABM(9000003.1,+$G(ABME("PH")),.06,"E"))
  1.  S ABMR(30,110)=$$FMT^ABMERUTL(ABMR(30,110),33)
  1.  Q
  1. 120 ;122-122 PPO/HMO Ind
  1.  S ABMR(30,120)=" "
  1.  Q
  1. 130 ;123-137 PPO ID
  1.  S ABMR(30,130)=""
  1.  S ABMR(30,130)=$$FMT^ABMERUTL(ABMR(30,130),15)
  1.  Q
  1. 140 ;138-152 Prior Authorization #
  1.  S ABME("FLD")=.58
  1.  D DIQ1
  1.  S ABMR(30,140)=$G(ABM(9002274.4,ABMP("BDFN"),.58,"E"))
  1.  S ABMR(30,140)=$$FMT^ABMERUTL(ABMR(30,140),15)
  1.  Q
  1. 150 ;153-153 Assign of Benefits
  1.  S ABME("FLD")=.75
  1.  D DIQ1
  1.  S ABMR(30,150)=ABM(9002274.4,ABMP("BDFN"),.75,"I")
  1.  S:ABMR(30,150)="" ABMR(30,150)="N"
  1.  S ABMR(30,150)=$$FMT^ABMERUTL(ABMR(30,150),1)
  1.  Q
  1. 160 ;154-154 Patient Signature Source
  1.  S ABME("FLD")=.74
  1.  D DIQ1
  1.  S ABMR(30,160)=$G(ABM(9002274.4,ABMP("BDFN"),.74,"I"))
  1.  S:ABMR(30,160)="" ABMR(30,160)="N"
  1.  I ABMR(30,160)="Y" S ABMR(30,160)="S"
  1.  I ABMR(30,160)="S",ABMR(30,150)="Y" S ABMR(30,160)="B"
  1.  I ABMR(30,150)="N",ABMR(30,160)="N" S ABMR(30,160)="P"
  1.  I ABMR(30,150)="Y",ABMR(30,160)="N" S ABMR(30,160)="M"
  1.  Q
  1. 170 ;155-156 Patient's Relationship to Insured
  1.  I '$G(ABME("PH")) S ABMR(30,170)="01"
  1.  I $G(ABME("PH")) S ABMR(30,170)=ABME("REL")
  1.  S ABMR(30,170)=$$FMT^ABMERUTL(ABMR(30,170),"2NR")
  1.  Q
  1. 180 ;157-181 Insured ID #
  1.  S ABMR(30,180)=$G(ABME("ID#"))
  1.  S ABMR(30,180)=$$FMT^ABMERUTL(ABMR(30,180),25)
  1.  Q
  1. 190 ;182-201 Insured Last Name
  1.  S ABMR(30,190)=$P(ABME("PHNM"),",",1)
  1.  S ABMR(30,190)=$$FMT^ABMERUTL(ABMR(30,190),20)
  1.  Q
  1. 200 ;202-213 Insured First Name
  1.  S ABMR(30,200)=$P(ABME("PHNM"),",",2)
  1.  S ABMR(30,200)=$P(ABMR(30,200)," ",1)
  1.  S ABMR(30,200)=$$FMT^ABMERUTL(ABMR(30,200),12)
  1.  Q
  1. 210 ;214-214 Insured MI
  1.  S ABMR(30,210)=$P(ABME("PHNM"),",",2)
  1.  S ABMR(30,210)=$P(ABMR(30,210)," ",2)
  1.  S ABMR(30,210)=$E(ABMR(30,210))
  1.  S ABMR(30,210)=$$FMT^ABMERUTL(ABMR(30,210),1)
  1.  Q
  1. 220 ;215-217 Insured Generation
  1.  S ABMR(30,220)=$P(ABME("PHNM"),",",2)
  1.  S ABMR(30,220)=$P(ABMR(30,220)," ",3)
  1.  S ABMR(30,220)=$$FMT^ABMERUTL(ABMR(30,220),3)
  1.  Q
  1. 230 ;218-218 Insured Sex
  1.  S ABMR(30,230)=$G(ABME("PHSEX"))
  1.  S ABMR(30,230)=$$FMT^ABMERUTL(ABMR(30,230),1)
  1.  Q
  1. 240 ;219-226 Insured DOB
  1.  S ABMR(30,240)=$G(ABME("DOB"))
  1.  S ABMR(30,240)=$$Y2KD2^ABMDUTL(ABMR(30,240))
  1.  S ABMR(30,240)=$$FMT^ABMERUTL(ABMR(30,240),8)
  1.  Q
  1. 250 ;227-227 Insured Employment Status Code
  1.  S ABMR(30,250)=""
  1.  I $G(ABME("PPP")) D                   ; of patient
  1.  .S ABME("FLD")=.21
  1.  .D DIQ3
  1.  .S ABMR(30,250)=$G(ABM(9000001,ABME("PPP"),.21,"I"))
  1.  .Q
  1.  I ABMR(30,250)="",$G(ABME("PH")) D    ; of policy holder
  1.  .S ABME("FLD")=.15
  1.  .D DIQ2
  1.  .S ABMR(30,250)=$G(ABM(9000003.1,+ABME("PH"),.15,"I"))
  1.  .Q
  1.  S ABMR(30,250)=$$FMT^ABMERUTL(ABMR(30,250),1)
  1.  Q
  1. 260 ;228-228 Supplemental Ins Ind
  1.  S ABMR(30,260)=""
  1.  S ABMR(30,260)=$$FMT^ABMERUTL(ABMR(30,260),1)
  1.  Q
  1. 270 ;229-235 Insurance Location ID
  1.  S ABMR(30,270)=""
  1.  S ABMR(30,270)=$$FMT^ABMERUTL(ABMR(30,270),7)
  1.  Q
  1. 280 ;236-260 Medicaid ID #
  1.  S ABMR(30,280)=$G(ABME("MCD#"))
  1.  S ABMR(30,280)=$$FMT^ABMERUTL(ABMR(30,280),25)
  1.  Q
  1. 290 ;261-273 Filler (National)
  1.  S ABMR(30,290)=""
  1.  S ABMR(30,290)=$$FMT^ABMERUTL(ABMR(30,290),13)
  1.  Q
  1. 300 ;274-320 Filler (Local)
  1.  S ABMR(30,300)=""
  1.  S ABMR(30,300)=$$FMT^ABMERUTL(ABMR(30,300),47)
  1.  Q
  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=".58;.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(9000001,ABMP("PDFN"),ABME("FLD")))
  1.  N I
  1.  S DIQ="ABM("
  1.  S DIQ(0)="EI"
  1.  S DIC="^AUPNPAT("
  1.  S DA=ABMP("PDFN")
  1.  S DR=".21"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1.  ;
  1. EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
  1.  ;
  1.  ;  INPUT:  ABMX = data element
  1.  ;             Y = 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,ABMZ,ABME,ABM
  1.  Q Y