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

ABME520A.m

Go to the documentation of this file. 
  1. ABME520A ; IHS/ASDST/DMJ - UB92 EMC RECORD 20 (Patient) cont'd ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;DMJ;02/07/96 12:33 PM
  1.  ;
  1.  ;IHS/DSD/MRS - 7/15/1999 NOIS BXX-0799-150034 Patch 3 #3
  1.  ;      Modified to allow spaces in patient last name   
  1.  ;
  1.  ; IHS/ASDS/LSL - 07/10/00 - V2.4 P2 - NOIS NDA-0700-180029
  1.  ;     Modified to strip off the leading zero of admission source
  1.  ;     and admission type.
  1.  ;
  1.  ; IHS/ASDS/LSL - 09/06/00 - V2.4 Patch 3 - NOIS CAA-0900-110008
  1.  ;     If nothing in Admission Source or Admission Type, make it
  1.  ;     null instead of 0 (zero).
  1.  ;
  1.  ; IHS/ASDS/DMJ - 06/14/01 - v2.4 Patch 5 - 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/DMJ - 09/07/01 - V2.4 Patch 7 - NOIS HQW-0701-100066
  1.  ;     Modifications made related to Medicare Part B
  1.  ;
  1.  ; IHS/ASDS/SDH - 09/27/01 - V2.4 Patch 9 - NOIS XAA-0901-200095
  1.  ;     After moving Kidscare to Page 5 from Page 7 found that there are
  1.  ;     checks that are done for Medicaid that should also be done for
  1.  ;     Kidscare.
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. LOOP ;LOOP HERE
  1.  F I=10:10:110 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. 10 ;Record type, 1-2
  1.  S ABMR(20,10)=20
  1.  Q
  1.  ;
  1. 20 ;Filler (National Use), 3-4
  1.  S ABMR(20,20)=""
  1.  S ABMR(20,20)=$$FMT^ABMERUTL(ABMR(20,20),2)
  1.  Q
  1.  ;
  1. 30 ;Patient Control Number, 5-24 (SOURCE: FILE=9000001.41,FIELD=.02)
  1.  S ABMR(20,30)=$$EX^ABMER20(30,ABMP("BDFN"))
  1.  S ABMR(20,30)=$$FMT^ABMERUTL(ABMR(20,30),20)
  1.  Q
  1.  ;
  1. 40 ;Patient Last Name, 25-44 (SOURCE: FILE=2, FIELD=.01)
  1.  ; form locator #12
  1.  I '$D(ABME("PNM")) D PNM
  1.  S ABMR(20,40)=$P(ABME("PNM"),",",1)
  1.  I $P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)="E" S ABMR(20,40)=$TR(ABMR(20,40),"-,.'/")
  1.  S ABMR(20,40)=$$FMT^ABMERUTL(ABMR(20,40),20)
  1.  Q
  1.  ;
  1. 50 ;Patient First Name, 45-53 (SOURCE: FILE=2, FIELD=.01)
  1.  ; form locator #12
  1.  I '$D(ABME("PNM")) D PNM
  1.  S ABMR(20,50)=$P(ABME("PNM"),",",2)
  1.  D
  1.  .Q:ABMR(20,50)="BABY BOY"
  1.  .Q:ABMR(20,50)="BABY GIRL"
  1.  .S ABMR(20,50)=$P(ABMR(20,50)," ",1)
  1.  S ABMR(20,50)=$$FMT^ABMERUTL(ABMR(20,50),9)
  1.  Q
  1.  ;
  1. 60 ;Patient Middle Initial, 54 (SOURCE: FILE=2, FIELD=.01)
  1.  ; form locator #12
  1.  I '$D(ABME("PNM")) D PNM
  1.  S ABMR(20,60)=$P(ABME("PNM"),",",2)
  1.  I ABMR(20,60)="BABY BOY" S ABMR(20,60)=" " Q
  1.  I ABMR(20,60)="BABY GIRL" S ABMR(20,60)=" " Q
  1.  S ABMR(20,60)=$P(ABMR(20,60)," ",2)
  1.  S ABMR(20,60)=$E(ABMR(20,60))
  1.  S ABMR(20,60)=$$FMT^ABMERUTL(ABMR(20,60),1)
  1.  Q
  1.  ;
  1. 70 ;Patient Sex Code, 55 (SOURCE: FILE=2, FIELD=.02)
  1.  ; form locator #15
  1.  I '$D(ABME("SEX")) D PNM
  1.  S ABMR(20,70)=$S(ABME("SEX")="":"U",1:ABME("SEX"))
  1.  Q
  1.  ;
  1. 80 ;Patient's Birth Date, 56-63 (SOURCE: FILE=2, FIELD=.03)
  1.  ; form locator #14
  1.  I '$D(ABME("DOB")) D PNM
  1.  S ABMR(20,80)=$$Y2KD2^ABMDUTL(ABME("DOB"))
  1.  Q
  1.  ;
  1. 90 ;Marital Status Code, 64 (SOURCE: FILE=2, FIELD=.05)
  1.  ; form locator #16
  1.  I '$D(ABME("MS")) D PNM
  1.  S ABMR(20,90)=$S(ABME("MS")=1:"D",ABME("MS")=2:"M",ABME("MS")=4:"W",ABME("MS")=5:"X",ABME("MS")=6:"S",1:"U")
  1.  Q
  1.  ;
  1. 100 ;Type of Admission, 65 (SOURCE: FILE=9002274.4, FIELD=.51)
  1.  ; form locator #19
  1.  S ABME("FLD")=.51
  1.  D DIQ1
  1.  S ABMR(20,100)=+ABM(9002274.4,ABMP("BDFN"),.51,"E")
  1.  ; if type of admission is "" and  visit type is outpatient and
  1.  ;    insurance type is Medicare FI set type of admission to 1
  1.  I 'ABMR(20,100),ABMP("VTYP")=131,ABMP("ITYPE")="R" S ABMR(20,100)=1
  1.  S:'ABMR(20,100) ABMR(20,100)=""
  1.  S ABMR(20,100)=$$FMT^ABMERUTL(ABMR(20,100),1)
  1.  Q
  1.  ;
  1. 110 ;Source of Admission, 66 (SOURCE: FILE=9002274.4, FIELD=.52)
  1.  ; form locator #20
  1.  S ABME("FLD")=.52
  1.  D DIQ1
  1.  S ABMR(20,110)=+ABM(9002274.4,ABMP("BDFN"),.52,"E")
  1.  ; if type of admission is "" and visit type is outpatient and
  1.  ;    insurance type is Medicare FI set type of admission to 1
  1.  I 'ABMR(20,110),ABMP("ITYPE")="R" S ABMR(20,110)=1
  1.  S:'ABMR(20,110) ABMR(20,110)=""
  1.  S ABMR(20,110)=$$FMT^ABMERUTL(ABMR(20,110),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=".01;.21;.51;.52;.53;.61;.62;.63;.64;.71;.72;.99"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1.  ;
  1. PNM ; EP
  1.  ; Patient name
  1.  K ABME("PNM"),ABME("DOB")
  1.  ; if insurer type is Medicare FI
  1.  I ABMP("ITYPE")="R" D
  1.  .; if insurer name contains "MEDICARE"
  1.  .I $P(^AUTNINS(ABMP("INS"),0),U)["MEDICARE" D
  1.  ..; Medicare Patient name from MEDICARE ELIGIBLE
  1.  ..S ABME("PNM")=$P($G(^AUPNMCR(ABMP("PDFN"),21)),U)
  1.  ..S ABME("DOB")=$P($G(^AUPNMCR(ABMP("PDFN"),21)),"^",2) ; DOB
  1.  .; If insurer name contains "RAILROAD"
  1.  .I $P(^AUTNINS(ABMP("INS"),0),U)["RAILROAD" D
  1.  ..; Railroad Patient name from RAILROAD ELIGIBLE
  1.  ..S ABME("PNM")=$P($G(^AUPNRRE(ABMP("PDFN"),21)),U)
  1.  ..S ABME("DOB")=$P($G(^AUPNRRE(ABMP("PDFN"),21)),"^",2) ; DOB
  1.  ;
  1.  ; if insurer type is Medicaid FI
  1.  I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D
  1.  .Q:'$G(ABMCDNUM)
  1.  .S ABME("PNM")=$P($G(^AUPNMCD(ABMCDNUM,21)),U) ; Pat name
  1.  .S ABME("DOB")=$P($G(^AUPNMCD(ABMCDNUM,21)),"^",2) ; dob
  1.  ;
  1.  ; Else get from patient file
  1.  S:$G(ABME("PNM"))="" ABME("PNM")=$P($G(^DPT(+ABMP("PDFN"),0)),U)
  1.  S:$G(ABME("DOB"))="" ABME("DOB")=$P(^DPT(ABMP("PDFN"),0),"^",3)
  1.  ; sex code & marital status
  1.  S ABME("SEX")=$P(^DPT(ABMP("PDFN"),0),"^",2),ABME("MS")=$P(^(0),"^",5)
  1.  Q
  1.  ;
  1. EX(ABMX,ABMY) ; EP
  1.  ; Extrincic 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