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

ABME520.m

Go to the documentation of this file. 
  1. ABME520 ; IHS/ASDST/DMJ - UB92 V5 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 - 6/14/01 - v2.4 p5 - NOIS NAI-0601-180016
  1.  ;    Modified to not check visit type, so if insurer is Medicare
  1.  ;    and there is blank admission type, admission source, and patient
  1.  ;    status 3p will insert a 1.
  1.  ;
  1.  ; IHS/ASDS/LSL - 10/30/01 - V2.4 Patch 9 - 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.  ; *********************************************************************
  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 ^ABME520A
  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 (SOURCE: FILE=9000001.41, FIELD=.02)
  1.  ; form locator #3
  1.  S ABMR(20,30)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)  ; bill #
  1.  S:$P($G(^ABMDPARM(DUZ(2),1,2)),"^",4)]"" ABMR(20,30)=ABMR(20,30)_"-"_$P($G(^(2)),"^",4)
  1.  ; Append HRN to bill number - suffix
  1.  I $P($G(^ABMDPARM(DUZ(2),1,3)),"^",3) D
  1.  .D 250
  1.  .S ABMR(20,30)=ABMR(20,30)_"-"_ABMR(20,250)
  1.  .Q
  1.  S ABMR(20,30)=$$FMT^ABMERUTL(ABMR(20,30),20)
  1.  Q
  1.  ;
  1. 120 ;EP - Patient Address - Line 1, 67-84 (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, 85-96 (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),12)
  1.  Q
  1.  ;
  1. 140 ;EP - Patient's City, 97-111 (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, 112-113 (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,114-122 (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, 123-130 (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)=$$Y2KD2^ABMDUTL(ABMR(20,170))
  1.  S ABMR(20,170)=$$FMT^ABMERUTL(ABMR(20,170),"8NR")
  1.  Q
  1.  ;
  1. 180 ;EP - Admission Hour, 131-132 (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, 133-140 (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)=$$Y2KD2^ABMDUTL(ABMR(20,190))
  1.  S ABMR(20,190)=$$FMT^ABMERUTL(ABMR(20,190),"8NR")
  1.  Q
  1.  ;
  1. 200 ;EP - Statement Covers Period Through, 141-148 (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)=$$Y2KD2^ABMDUTL(ABMR(20,200))
  1.  S ABMR(20,200)=$$FMT^ABMERUTL(ABMR(20,200),"8NR")
  1.  Q
  1.  ;
  1. 210 ;EP - Patient Status, 149-150 (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("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, 151-152 (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 - Payments Received (Patient line), 153-162 (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 (Patient line), 163-172 (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, 172-189 (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.  I ABMRCID="00MAD" S ABMR(20,250)=$$FMT^ABMERUTL(ABMR(20,30),17)
  1.  Q
  1.  ;
  1. 260 ;EP - Filler (National Use), 190-192
  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