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

ABMEH31.m

Go to the documentation of this file. 
  1. ABMEH31 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD DA1 (Insurance Information) ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/ASDS/LSL - 04/05/01 - V2.4 Patch 9 - NOIS NHA-0600-180066
  1.  ;     Need to 0 fill numeric fields in the DA1 record.  The fields
  1.  ;     are Disallowed other (121-127), Allowed amount (128-134), 
  1.  ;     Deductible amount (135-141), and Coinsurance amount (142-148).
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. START ;START HERE
  1.  K ABMR(31),ABMREC(31,ABME("S#"))
  1.  S ABME("RTYPE")=31       ; Record type
  1.  D SET^ABMERUTL
  1.  D PAYED^ABMERUTL
  1.  D ADDR
  1.  D LOOP
  1.  D S90^ABMERUTL           ; Increment record type counter
  1.  K ABMADR,ABMP("PAYED")
  1.  Q
  1.  ;
  1. LOOP ;LOOP HERE
  1.  F I=10:10:260 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 ;1-3 Record ID
  1.  S ABMR(31,10)="DA1"
  1.  Q
  1.  ;
  1. 20 ;4-5 Sequence #
  1.  S ABMR(31,20)="0"_ABME("S#")
  1.  S ABMR(31,20)=$$FMT^ABMERUTL(ABMR(31,20),2)
  1.  Q
  1.  ;
  1. 30 ;6-22 Patient Control Number
  1.  S ABMR(31,30)=ABMP("PCN")
  1.  S ABMR(31,30)=$$FMT^ABMERUTL(ABMR(31,30),17)
  1.  Q
  1.  ;
  1. 40 ;23-52 Payor Address Line 1
  1.  S ABMR(31,40)=ABMADR(2)
  1.  S ABMR(31,40)=$$FMT^ABMERUTL(ABMR(31,40),30)
  1.  Q
  1.  ;
  1. 50 ;53-82 Payor Address Line 2
  1.  S ABMR(31,50)=""
  1.  S ABMR(31,50)=$$FMT^ABMERUTL(ABMR(31,50),30)
  1.  Q
  1.  ;
  1. 60 ;83-102 Payor City
  1.  S ABMR(31,60)=ABMADR(3)
  1.  S ABMR(31,60)=$$FMT^ABMERUTL(ABMR(31,60),20)
  1.  Q
  1.  ;
  1. 70 ;103-104 Payor State
  1.  S ABMR(31,70)=ABMADR(4)
  1.  S ABMR(31,70)=$$FMT^ABMERUTL(ABMR(31,70),2)
  1.  Q
  1.  ;
  1. 80 ;103-113 Payor Zip
  1.  S ABMR(31,80)=ABMADR(5)
  1.  S ABMR(31,80)=$$FMT^ABMERUTL(ABMR(31,80),"9")
  1.  Q
  1. 90 ;114-120 Dissallowed Cost Cont
  1.  S ABMR(31,90)=""
  1.  S ABMR(31,90)=$$FMT^ABMERUTL(ABMR(31,90),7)
  1.  Q
  1. 100 ;121-127 Disallowed Other
  1.  S ABMR(31,100)=""
  1.  S ABMR(31,100)=$$FMT^ABMERUTL(ABMR(31,100),"7NRJ2")
  1.  Q
  1. 110 ;128-134 Allowed Amount
  1.  S ABMR(31,110)=""
  1.  S ABMR(31,110)=$$FMT^ABMERUTL(ABMR(31,110),"7NRJ2")
  1.  Q
  1. 120 ;135-141 Deductible Amount
  1.  S ABMR(31,120)=""
  1.  S ABMR(31,120)=$$FMT^ABMERUTL(ABMR(31,120),"7NRJ2")
  1.  Q
  1. 130 ;142-148 Coinsurance Amount
  1.  S ABMR(31,130)=""
  1.  S ABMR(31,130)=$$FMT^ABMERUTL(ABMR(31,130),"7NRJ2")
  1.  Q
  1. 140 ;149-155 Payor Amount Payed
  1.  S ABMR(31,140)=$G(ABMP("PAYED",+ABME("INS")))
  1.  S ABMR(31,140)=$$FMT^ABMERUTL(ABMR(31,140),"7NRJ2")
  1.  Q
  1. 150 ;156-156 Zero Pay Indicator
  1.  S ABMR(31,150)=""
  1.  S ABMR(31,150)=$$FMT^ABMERUTL(ABMR(31,150),1)
  1.  Q
  1. 160 ;157-158 Adjucation Ind 1
  1.  S ABMR(31,160)=""
  1.  S ABMR(31,160)=$$FMT^ABMERUTL(ABMR(31,160),2)
  1.  Q
  1. 170 ;159-160 Adjudication Ind 2
  1.  S ABMR(31,170)=""
  1.  S ABMR(31,170)=$$FMT^ABMERUTL(ABMR(31,170),2)
  1.  Q
  1. 180 ;161-162 Adjudication Ind 3
  1.  S ABMR(31,180)=""
  1.  S ABMR(31,180)=$$FMT^ABMERUTL(ABMR(31,180),2)
  1.  Q
  1. 190 ;163-163 Champus Spnsr Branch
  1.  S ABMR(31,190)=""
  1.  S ABMR(31,190)=$$FMT^ABMERUTL(ABMR(31,190),1)
  1.  Q
  1. 200 ;164-165 Champus Spnsr Grade
  1.  S ABMR(31,200)=""
  1.  S ABMR(31,200)=$$FMT^ABMERUTL(ABMR(31,200),2)
  1.  Q
  1. 210 ;166-166 Champus Spnsr Status
  1.  S ABMR(31,210)=""
  1.  S ABMR(31,210)=$$FMT^ABMERUTL(ABMR(31,210),1)
  1.  Q
  1. 220 ;167-174 Ins Card Effect Date
  1.  S ABMR(31,220)=""
  1.  S ABMR(31,220)=$$FMT^ABMERUTL(ABMR(31,220),8)
  1.  Q
  1. 230 ;175-182 Ins Card Term Date
  1.  S ABMR(31,230)=""
  1.  S ABMR(31,230)=$$FMT^ABMERUTL(ABMR(31,230),8)
  1.  Q
  1. 240 ;183-189 Balance Due
  1.  S ABMR(31,240)=""
  1.  S ABMR(31,240)=$$FMT^ABMERUTL(ABMR(31,240),7)
  1.  Q
  1. 250 ;190-252 Filler (National)
  1.  S ABMR(31,250)=""
  1.  S ABMR(31,250)=$$FMT^ABMERUTL(ABMR(31,250),63)
  1.  Q
  1. 260 ;301-320 Filler (Local)
  1.  S ABMR(31,260)=""
  1.  S ABMR(31,260)=$$FMT^ABMERUTL(ABMR(31,260),68)
  1.  Q
  1. ADDR ;Payor Address Info
  1.  K ABMADR
  1.  N I F I=1:1:5 S ABMADR(I)=$P(^AUTNINS(ABME("INS"),0),"^",I)
  1.  S ABMADR(4)=$P($G(^DIC(5,+ABMADR(4),0)),"^",2)
  1.  Q
  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