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

ABMEH20.m

Go to the documentation of this file. 
  1. ABMEH20 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD CA0 (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 - 05/03/01 - V2.4 Patch 5 - NOIS HQW-0401-100014
  1.  ;     Modified to strip dash from zip code
  1.  ;
  1.  ; IHS/FCS/DRS - 09/17/01 - V2.4 P 9 - no incr tax id! 
  1.  ;
  1. START ;START HERE
  1.  K ABMREC(20),ABMR(20)
  1.  S ABME("RTYPE")=20
  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.  F I=10:10:310 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. 10 ;1-3 Record ID
  1.  S ABMR(20,10)="CA0"
  1.  Q
  1. 20 ;4-5 Filler
  1.  S ABMR(20,20)=""
  1.  S ABMR(20,20)=$$FMT^ABMERUTL(ABMR(20,20),2)
  1.  Q
  1. 30 ;6-22 Patient Control Number
  1.  S ABMR(20,30)=ABMP("PCN")
  1.  S ABMR(20,30)=$$FMT^ABMERUTL(ABMR(20,30),17)
  1.  Q
  1. 40 ;23-42 Patient Last Name
  1.  D PNM^ABMER20A
  1.  S ABMR(20,40)=$P(ABME("PNM"),",",1)
  1.  S ABMR(20,40)=$$FMT^ABMERUTL(ABMR(20,40),20)
  1.  Q
  1. 50 ;43-54 Patient First Name
  1.  S ABMR(20,50)=$P(ABME("PNM"),",",2)
  1.  S ABMR(20,50)=$P(ABMR(20,50)," ",1)
  1.  S ABMR(20,50)=$$FMT^ABMERUTL(ABMR(20,50),12)
  1.  Q
  1. 60 ;55-55 Patient MI
  1.  S ABMR(20,60)=$P(ABME("PNM"),",",2)
  1.  S ABMR(20,60)=$P(ABMR(20,60)," ",2)
  1.  S ABMR(20,60)=$$FMT^ABMERUTL(ABMR(20,60),1)
  1.  Q
  1. 70 ;56-58 Patient Generation
  1.  S ABMR(20,70)=""
  1.  S ABMR(20,70)=$$FMT^ABMERUTL(ABMR(20,70),3)
  1.  Q
  1. 80 ;59-66 Patient DOB
  1.  S ABMR(20,80)=$$Y2KD2^ABMDUTL(ABME("DOB"))
  1.  Q
  1. 90 ;67-67 Patient Sex
  1.  S ABMR(20,90)=$S(ABME("SEX")="":"U",1:ABME("SEX"))
  1.  Q
  1. 100 ;68-68 Patient Type of Residence
  1.  S ABMR(20,100)=" "
  1.  Q
  1. 110 ;69-98 Patient Address 1
  1.  D ADR
  1.  S ABMR(20,110)=ABME("AD1")
  1.  S ABMR(20,110)=$$FMT^ABMERUTL(ABMR(20,110),30)
  1.  Q
  1. 120 ;99-128 Patient Address 2
  1.  S ABMR(20,120)=ABME("AD2")
  1.  S ABMR(20,120)=$$FMT^ABMERUTL(ABMR(20,120),30)
  1.  Q
  1. 130 ;129-148 Patient City
  1.  S ABMR(20,130)=ABME("AD4")
  1.  S ABMR(20,130)=$$FMT^ABMERUTL(ABMR(20,130),20)
  1.  Q
  1. 140 ;149-150 Patient State
  1.  S ABMR(20,140)=ABME("AD5")
  1.  S:ABMR(20,140)="" ABMR(20,140)="  "
  1.  Q
  1. 150 ;151-159 Patient Zip
  1.  S ABMR(20,150)=ABME("AD6")
  1.  S ABMR(20,150)=$$FMT^ABMERUTL(ABMR(20,150),"9S")
  1.  Q
  1. 160 ;160-169 Patient Phone
  1.  S ABMR(20,160)=$P($G(^DPT(+ABMP("PDFN"),.13)),U)
  1.  S:ABMR(20,160)="" ABMR(20,160)=$P($G(^DPT(+ABMP("PDFN"),.13)),"^",2)
  1.  S ABMR(20,160)=$TR(ABMR(20,160),"()- ")
  1.  S ABMR(20,160)=$$FMT^ABMERUTL(ABMR(20,160),10)
  1.  Q
  1. 170 ;170-170 Patient Marital Status
  1.  S ABMR(20,170)=$P($G(^DPT(+ABMP("PDFN"),0)),"^",5)
  1.  S:ABMR(20,170) ABMR(20,170)=$E("DM WXSU",ABMR(20,170))
  1.  S ABMR(20,170)=$$FMT^ABMERUTL(ABMR(20,170),1)
  1.  Q
  1. 180 ;171-171 Patient Student Status
  1.  S ABMR(20,180)=" "
  1.  Q
  1. 190 ;172-172 Patient Employment Status
  1.  S ABMR(20,190)=$P($G(^AUPNPAT(+ABMP("PDFN"),0)),"^",21)
  1.  S:ABMR(20,190)="" ABMR(20,190)=$P($G(^DPT(+ABMP("PDFN"),.311)),"^",15)
  1.  S ABMR(20,190)=$$FMT^ABMERUTL(ABMR(20,190),1)
  1.  Q
  1. 200 ;173-173 Patient Death Indicator
  1.  S ABMR(20,200)=" "
  1.  S:$P($G(^DPT(+ABMP("PDFN"),.35)),U) ABMR(20,200)="D"
  1.  Q
  1. 210 ;174-181 Patient Date of Death
  1.  S ABMR(20,210)=$P($G(^DPT(+ABMP("PDFN"),.35)),U)
  1.  S ABMR(20,210)=$$Y2KD2^ABMDUTL(ABMR(20,210))
  1.  S ABMR(20,210)=$$FMT^ABMERUTL(ABMR(20,210),8)
  1.  Q
  1. 220 ;182-182 Other Insurance Indicator
  1.  S ABMR(20,220)=" "
  1.  Q
  1. 230 ;183-183 Claim Editing Indicator
  1.  S ABMR(20,230)=ABMP("SOP")
  1.  Q
  1. 240 ;184-185 Type of Claim Indicator
  1.  S ABMR(20,240)="  "
  1.  Q
  1. 250 ;186-186 Legal Rep Indicator
  1.  S ABMR(20,250)=" "
  1.  Q
  1. 260 ;187-195 Origin Code
  1.  S ABMR(20,260)=""
  1.  S ABMR(20,260)=$$FMT^ABMERUTL(ABMR(20,260),9)
  1.  Q
  1. 270 ;196-212 Payor Clm Control Number
  1.  S ABMR(20,270)=""
  1.  S ABMR(20,270)=$$FMT^ABMERUTL(ABMR(20,270),17)
  1.  Q
  1. 280 ;213-227 Pay To Provider Number
  1.  S ABMR(20,280)=""
  1.  S ABMR(20,280)=$$FMT^ABMERUTL(ABMR(20,280),15)
  1.  Q
  1. 290 ;228-233 Claim ID Number
  1.  S ABMR(20,290)=""
  1.  S ABMR(20,290)=$$FMT^ABMERUTL(ABMR(20,290),6)
  1.  Q
  1. 300 ;234-237 For Encounter Data Only
  1.  S ABMR(20,300)=""
  1.  S ABMR(20,300)=$$FMT^ABMERUTL(ABMR(20,300),4)
  1.  Q
  1. 310 ;238-320 Filler
  1.  S ABMR(20,310)=""
  1.  S ABMR(20,310)=$$FMT^ABMERUTL(ABMR(20,310),83)
  1.  Q
  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. 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