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

ABMER20.m

Go to the documentation of this file. 
  1. ABMER20 ; IHS/ASDST/DMJ - UB92 EMC RECORD 20 (Patient) ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;DMJ;02/26/96 5:11 PM
  1.  ;
  1.  ; IHS/ASDS/DMJ - 04/20/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/02/00 - V2.4 Patch 3 - NOIS NDA-0700-180015
  1.  ;     In order to get bill number on RA from Consultec, bill number
  1.  ;     must be in field 3 and 25.
  1.  ;
  1.  ; IHS/ASDS/DMJ - v2.4 p7 - 9/7/01 NOIS HQW-0701-100066
  1.  ;     Modifications made related to Medicare Part B
  1.  ;
  1. START ;START HERE
  1.  K ABMREC(20),ABMR(20)
  1.  S ABME("RTYPE")=20
  1.  S ABMRT(95,60)=+$G(ABMRT(95,60))+1
  1.  K ABMP("SET")
  1.  D SET^ABMERUTL,LOOP
  1.  D S90^ABMERUTL
  1.  K ABME,ABM
  1.  Q
  1.  ;
  1. LOOP ;LOOP HERE
  1.  D ^ABMER20A
  1.  F I=120:10:260 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),20,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(20)=$G(ABMREC(20))_ABMR(20,I)
  1.  Q
  1.  ;
  1. 30 ;EP -Patient Control Number
  1.  ; form locator #3
  1.  D PCN^ABMERUTL
  1.  S ABMR(20,30)=ABMP("PCN")
  1.  Q
  1.  ;
  1. 120 ;EP - Patient Address - Line 1 (SOURCE: FILE=2, FIELD=.111)
  1.  ; form locator #13
  1.  D:'$D(ABME("AD1")) ADR
  1.  S ABMR(20,120)=ABME("AD1")
  1.  S ABMR(20,120)=$$FMT^ABMERUTL(ABMR(20,120),18)
  1.  Q
  1.  ;
  1. 130 ;EP - Patient Address - Line 2 (SOURCE: FILE=2, FIELD=.112)
  1.  ; form locator #13
  1.  D:'$D(ABME("AD2")) ADR
  1.  S ABMR(20,130)=ABME("AD2")
  1.  S ABMR(20,130)=$$FMT^ABMERUTL(ABMR(20,130),18)
  1.  Q
  1.  ;
  1. 140 ;EP - Patient's City (SOURCE: FILE=2, FIELD=.114)
  1.  ; form locator #13
  1.  D:'$D(ABME("AD4")) ADR
  1.  S ABMR(20,140)=ABME("AD4")
  1.  S ABMR(20,140)=$$FMT^ABMERUTL(ABMR(20,140),15)
  1.  Q
  1.  ;
  1. 150 ;EP - Patient's State (SOURCE: FILE=2, FIELD=.115)
  1.  ; form locator #13
  1.  D:'$D(ABME("AD5")) ADR
  1.  S ABMR(20,150)=ABME("AD5")
  1.  S:ABMR(20,150)="" ABMR(20,150)="  "
  1.  Q
  1.  ;
  1. 160 ;EP - Patient's Zip (SOURCE: FILE=2, FIELD=.116)
  1.  ; form locator #13
  1.  D:'$D(ABME("AD6")) ADR
  1.  S ABMR(20,160)=ABME("AD6")
  1.  I '$G(ABMP("NOFMT")) D
  1.  .S:ABME("AD6")="" ABME("AD6")="00000"
  1.  S ABMR(20,160)=$E(ABME("AD6"),1,5)_"0000"
  1.  S ABMR(20,160)=$$FMT^ABMERUTL(ABMR(20,160),9)
  1.  Q
  1.  ;
  1. ADR ;GET PATIENT ADDRESS FROM FILE 2
  1.  ; I = 1 - Mailing Address - Street
  1.  ;     2 - Street Address [line 2]
  1.  ;     3 - Street Address [line 3]
  1.  ;     4 - Mailing Address - City
  1.  ;     5 - Mailing Address - State
  1.  ;     6 - Mailing Address - Zip
  1.  N I
  1.  F I=1:1:6 S ABME("AD"_I)=$P($G(^DPT(+ABMP("PDFN"),.11)),"^",I)
  1.  S ABME("AD5")=$P($G(^DIC(5,+ABME("AD5"),0)),"^",2)
  1.  Q
  1.  ;
  1. 170 ;EP - Admission/Start of Care Date (SOURCE: FILE=9002274.4, FIELD=.71)
  1.  ; form locator #17
  1.  S ABME("FLD")=.71
  1.  D DIQ1
  1.  S ABMR(20,170)=ABM(9002274.4,ABMP("BDFN"),.71,"I")
  1.  S ABMR(20,170)=$$MDY^ABMDUTL(ABMR(20,170))
  1.  S ABMR(20,170)=$$FMT^ABMERUTL(ABMR(20,170),"6NR")
  1.  Q
  1.  ;
  1. 180 ;EP - Admission Hour (SOURCE: FILE=9002274.4, FIELD=.62)
  1.  ; form locator #18
  1.  S ABME("FLD")=.62
  1.  D DIQ1
  1.  S ABMR(20,180)=ABM(9002274.4,ABMP("BDFN"),.62,"I")
  1.  S ABMR(20,180)=$$FMT^ABMERUTL(ABMR(20,180),"2NR")
  1.  Q
  1.  ;
  1. 190 ;EP - Statement Covers Period From (SOURCE: FILE=9002274.4, FIELD=.71)
  1.  ; form locator #6
  1.  S ABME("FLD")=.71
  1.  D DIQ1
  1.  S ABMR(20,190)=ABM(9002274.4,ABMP("BDFN"),.71,"I")
  1.  S ABMR(20,190)=$$MDY^ABMDUTL(ABMR(20,190))
  1.  S ABMR(20,190)=$$FMT^ABMERUTL(ABMR(20,190),"6NR")
  1.  Q
  1.  ;
  1. 200 ;EP - Statement Covers Period Through (SOURCE: FILE=9002274.4, FIELD=.72)
  1.  ; form locator #6
  1.  S ABME("FLD")=.72
  1.  D DIQ1
  1.  S ABMR(20,200)=ABM(9002274.4,ABMP("BDFN"),.72,"I")
  1.  S ABMR(20,200)=$$MDY^ABMDUTL(ABMR(20,200))
  1.  S ABMR(20,200)=$$FMT^ABMERUTL(ABMR(20,200),"6NR")
  1.  Q
  1.  ;
  1. 210 ;EP - Patient Status (SOURCE: FILE=9002274.4, FIELD=.53)
  1.  ; form locator #22
  1.  S ABME("FLD")=.53
  1.  D DIQ1
  1.  S ABMR(20,210)=ABM(9002274.4,ABMP("BDFN"),.53,"E")
  1.  ; If status is "" and visit is outpatient and insurance type is 
  1.  ; Medicare FI, set status to 1
  1.  I ABMR(20,210)="",ABMP("VTYP")=131,ABMP("ITYPE")="R" S ABMR(20,210)=1
  1.  S ABMR(20,210)=$$FMT^ABMERUTL(ABMR(20,210),"2NR")
  1.  Q
  1.  ;
  1. 220 ;EP - Discharge Hour (SOURCE: FILE=9002274.4, FIELD=.64)
  1.  ; form locator #21
  1.  S ABME("FLD")=.64
  1.  D DIQ1
  1.  S ABMR(20,220)=ABM(9002274.4,ABMP("BDFN"),.64,"I")
  1.  S ABMR(20,220)=$$FMT^ABMERUTL(ABMR(20,220),"2NR")
  1.  Q
  1.  ;
  1. 230 ;EP - Patient Has Paid (SOURCE: FILE=9002274.4, FIELD=.99)
  1.  S ABME("FLD")=.99
  1.  D DIQ1
  1.  S ABMR(20,230)=ABM(9002274.4,ABMP("BDFN"),.99,"E")
  1.  S ABMR(20,230)=$$FMT^ABMERUTL(ABMR(20,230),"10NRJ2")
  1.  Q
  1.  ;
  1. 240 ;EP - Estimated Amount Due (SOURCE: FILE=, FIELD=)
  1.  S ABME("FLD")=.21
  1.  D DIQ1
  1.  S ABMR(20,240)=ABM(9002274.4,ABMP("BDFN"),.21,"E")
  1.  S ABMR(20,240)=$$FMT^ABMERUTL(ABMR(20,240),"10NRJ2")
  1.  Q
  1.  ;
  1. 250 ;EP - Medical Record Number (SOURCE: FILE=9000001.41, FIELD=.02)
  1.  ; form locator #23
  1.  S ABMR(20,250)=$P($G(^AUPNPAT(+ABMP("PDFN"),41,+ABMP("LDFN"),0)),"^",2)
  1.  S ABMR(20,250)=$$FMT^ABMERUTL(ABMR(20,250),17)
  1.  ; if Export is UB-92-E V4 and New Mexico Medicaid, use bill number
  1.  I ABMP("EXP"),$G(ABMRCID)="00MAD" S ABMR(20,250)=$$FMT^ABMERUTL(ABMR(20,30),17)
  1.  Q
  1.  ;
  1. 260 ;EP - Filler
  1.  S ABMR(20,260)=""
  1.  S ABMR(20,260)=$$FMT^ABMERUTL(ABMR(20,260),3)
  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=".01;.21;.51;.52;.53;.61;.62;.63;.64;.71;.72;.99"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1.  ;
  1. EX(ABMX,ABMY) ;EP - 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),ABMX,ABMY
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  Q Y