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

ABMEH01.m

Go to the documentation of this file. 
  1. ABMEH01 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD AA0 (Submitter Data) ;     
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/ASDS/DMJ - 10/18/00 - V2.4 Patch 3 - NOIS HQW-1000-100031
  1.  ;     Modified to add Federal Tax ID number
  1.  ;
  1.  ; IHS/ASDS/DMJ - 01/23/01 - V2.4 Patch3 - NOIS HQW-0800-100133
  1.  ;     Modified to pick up provider number that was missing from BA1
  1.  ;       record for satellite locations.
  1.  ;
  1.  ; IHS/ASDS/DMJ - 02/07/01 - V2.4 Patch4 - NOIS NCA-0201-180004
  1.  ;     Modified to fix issue with submitter ID in electronic trans.
  1.  ;
  1. START ;START HERE
  1.  K ABMREC(1),ABMR(1)
  1.  S ABME("RTYPE")=1
  1.  D LOOP
  1.  S ABMRT(99,"RTOT")=1
  1.  K ABME,ABM
  1.  Q
  1. LOOP ;LOOP HERE
  1.  F I=10:10:290 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),1,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(1)=$G(ABMREC(1))_ABMR(1,I)
  1.  Q
  1. 10 ;1-3 Record type
  1.  S ABMR(1,10)="AA0"
  1.  Q
  1. 20 ;4-19 Submitter ID
  1.  S ABMR(1,20)=$P($G(^AUTTLOC(DUZ(2),0)),"^",18)
  1.  S ABMR(1,20)=$TR(ABMR(1,20),"-")
  1.  I $$RCID^ABMERUTL(ABMP("INS"))=99999 D
  1.  .S ABMR(1,20)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",19)
  1.  .S:ABMR(1,20)="" ABMR(1,20)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),"^",2)
  1.  .S:ABMR(1,20)="" ABMR(1,20)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",2)
  1.  S ABMR(1,20)=$$FMT^ABMERUTL(ABMR(1,20),16)
  1.  S ABMP("SUBID")=ABMR(1,20)
  1.  Q
  1. 30 ;20-28 Reserved 
  1.  S ABMR(1,30)=""
  1.  S ABMR(1,30)=$$FMT^ABMERUTL(ABMR(1,30),9)
  1.  Q
  1. 40 ;29-34 Submission Type
  1.  D SOP^ABMERUTL
  1.  S ABMR(1,40)=ABMP("SOP")
  1.  S ABMR(1,40)=$$FMT^ABMERUTL(ABMR(1,40),6)
  1.  Q
  1. 50 ;35-40 Submission #
  1.  I $$RCID^ABMERUTL(ABMP("INS"))=99999 D  Q
  1.  .S ABMR(1,50)=$E($H,3,5)_$E($H,9,11)
  1.  .S ABMR(1,50)=$$FMT^ABMERUTL(ABMR(1,50),6)
  1.  S ABMR(1,50)="0000"_$G(ABMP("XMIT"))
  1.  S ABMR(1,50)=$E(ABMR(1,50),$L(ABMR(1,50))-2,$L(ABMR(1,50)))
  1.  S ABMR(1,50)=$E(DUZ(2),$L(DUZ(2))-1,$L(DUZ(2)))_ABMR(1,50)
  1.  S ABMR(1,50)=ABMR(1,50)+100000
  1.  S ABMR(1,50)=$$FMT^ABMERUTL(ABMR(1,50),6)
  1.  Q
  1. 60 ;41-73 Submitter Name
  1.  D DIQ2 S ABMR(1,60)=ABM(9999999.06,ABMP("LDFN"),.01,"E")
  1.  S ABMR(1,60)=$$FMT^ABMERUTL(ABMR(1,60),33)
  1.  Q
  1. 70 ;74-103 Submitter Address-1
  1.  D DIQ2 S ABMR(1,70)=ABM(9999999.06,ABMP("LDFN"),.14,"E")
  1.  S ABMR(1,70)=$$FMT^ABMERUTL(ABMR(1,70),30)
  1.  Q
  1. 80 ;104-133 Submitter Address-2
  1.  S ABMR(1,80)=""
  1.  S ABMR(1,80)=$$FMT^ABMERUTL(ABMR(1,80),30)
  1.  Q
  1. 90 ;134-153 Submitter City
  1.  D DIQ2 S ABMR(1,90)=ABM(9999999.06,ABMP("LDFN"),.15,"E")
  1.  S ABMR(1,90)=$$FMT^ABMERUTL(ABMR(1,90),20)
  1.  Q
  1. 100 ;154-155 Submitter State
  1.  D DIQ2 S ABMR(1,100)=ABM(9999999.06,ABMP("LDFN"),.16,"I")
  1.  S ABMR(1,100)=$P($G(^DIC(5,+ABMR(1,100),0)),"^",2)
  1.  S ABMR(1,100)=$$FMT^ABMERUTL(ABMR(1,100),2)
  1.  Q
  1. 110 ;156-164 Submitter Zip
  1.  D DIQ2 S ABMR(1,110)=ABM(9999999.06,ABMP("LDFN"),.17,"E")
  1.  S ABMR(1,110)=$$FMT^ABMERUTL(ABMR(1,110),9)
  1.  Q
  1. 120 ;165-169 Submitter Region
  1.  S ABMR(1,120)=""
  1.  S ABMR(1,120)=$$FMT^ABMERUTL(ABMR(1,120),5)
  1.  Q
  1. 130 ;170-202 Submitter Contact
  1.  S ABMR(1,130)="BUSINESS OFFICE MANAGER"
  1.  S ABMR(1,130)=$$FMT^ABMERUTL(ABMR(1,130),33)
  1.  Q
  1. 140 ;203-212 Submitter Telephone Number
  1.  D DIQ2 S ABMR(1,140)=ABM(9999999.06,ABMP("LDFN"),.13,"E")
  1.  S ABMR(1,140)=$TR(ABMR(1,140),"() -")
  1.  S ABMR(1,140)=$$FMT^ABMERUTL(ABMR(1,140),10)
  1.  Q
  1. 150 ;213-220 Creation Date
  1.  S ABMR(1,150)=$$Y2KD2^ABMDUTL(DT)
  1.  Q
  1. 160 ;221-226 Submission Time
  1.  S ABMR(1,160)=""
  1.  S ABMR(1,160)=$$FMT^ABMERUTL(ABMR(1,160),6)
  1.  Q
  1. 170 ;227-242 Receiver ID
  1.  S ABMR(1,170)=$$RCID^ABMERUTL(ABMP("INS"))
  1.  S ABMR(1,170)=$$FMT^ABMERUTL(ABMR(1,170),16)
  1.  Q
  1. 180 ;243-243 Receiver Type
  1.  S ABMR(1,180)=$G(ABMR(1,40))
  1.  S ABMR(1,180)=$E(ABMR(1,180))
  1.  S:ABMR(1,180)="" ABMR(1,180)=" "
  1.  Q
  1. 190 ;244-248 Version Code-National
  1.  S ABMR(1,190)="00200"
  1.  Q
  1. 200 ;249-253 Version Code-Local
  1.  S ABMR(1,200)="00200"
  1.  Q
  1. 210 ;254-257 Test/Prod Indicator
  1.  S ABMR(1,210)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),"^",4)
  1.  S ABMR(1,210)=$S(ABMR(1,210)["T":"TEST",1:"PROD")
  1.  S ABMR(1,210)=$$FMT^ABMERUTL(ABMR(1,210),4)
  1.  Q
  1. 220 ;258-265 Password
  1.  S ABMR(1,220)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),"^",3)
  1.  S ABMR(1,220)=$$FMT^ABMERUTL(ABMR(1,220),8)
  1.  Q
  1. 230 ;266-266 Retransmission Status
  1.  S ABMR(1,230)=" "
  1.  Q
  1. 240 ;267-282 Original Submitter ID
  1.  S ABMR(1,240)=""
  1.  S ABMR(1,240)=$$FMT^ABMERUTL(ABMR(1,240),16)
  1.  Q
  1. 250 ;283-283 Vendor Application Cat.
  1.  S ABMR(1,250)=" "
  1.  Q
  1. 260 ;284-288 Vendor Software Version
  1.  S ABMR(1,260)="2.4  "
  1.  Q
  1. 270 ;289-290 Vendor Software Update
  1.  S ABMR(1,270)="P3"
  1.  Q
  1. 280 ;291-292 Filler (National Use)
  1.  S ABMR(1,280)="  "
  1.  Q
  1. 290 ;293-320 Filler (Local Use)
  1.  S ABMR(1,290)=""
  1.  S ABMR(1,290)=$$FMT^ABMERUTL(ABMR(1,290),28)
  1.  Q
  1. DIQ1 ;PULL BILL DATA VIA DIQ1
  1.  Q:$D(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
  1.  N I S DIQ="ABM(",DIQ(0)="EI",DIC="^ABMDBILL(DUZ(2),",DA=ABMP("BDFN")
  1.  S DR=".01;.21;.51;.52;.53;.61;.62;.63;.64;.71;.72;.99"
  1.  D EN^DIQ1 K DIQ
  1.  Q
  1. DIQ2 ;GET LOCATION INFORMATION
  1.  Q:$D(ABM(9999999.06,ABMP("LDFN")))
  1.  N I S DIQ="ABM",DIQ(0)="IE",DIC="^AUTTLOC(",DA=ABMP("LDFN")
  1.  S DR=".01;.13;.14;.15;.16;.17;.21"
  1.  D EN^DIQ1 K DIQ
  1.  Q
  1. EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE (X=data element, Y=bill internal entry number)
  1.  S ABMP("BDFN")=ABMY 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),ABME,ABM,ABMX,ABMY
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  Q Y