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

ABMEAA0.m

Go to the documentation of this file. 
  1. ABMEAA0 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD AA0 (Submitter Data) Envoy version ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/ASDS/DMJ - 03/01/01 - V2.4 P5 - NOIS HQW-0301-100010
  1.  ;    This is a new routine to address a new electronic format for Envoy
  1.  ;
  1.  ; IHS/FCS/DRS - 09/17/01 - V2.4 P9
  1.  ;    Part 14a - Payer ID changes
  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.  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.  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,DUZ(2),.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,DUZ(2),.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,DUZ(2),.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,DUZ(2),.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,DUZ(2),.17,"E")
  1.  S ABMR(1,110)=$$FMT^ABMERUTL(ABMR(1,110),"9S")
  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,DUZ(2),.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.  ; ABM*2.4*9 IHS/FCS/DRS 09/21/01 ; Part 14a - give priority to the Envoy ID
  1.  ; And if it's not there, fall back to the $P(^AUTNINS(D0,0),U,8) ID #
  1.  S ABMR(1,170)=""
  1.  I $$ENVOY^ABMEF19 D
  1.  . S ABMR(1,170)=$$ENVY^ABMERUTL(ABMP("INS"),ABMP("VTYP"))
  1.  I ABMR(1,170)="" 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(DUZ(2),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(DUZ(2),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.5  "
  1.  Q
  1. 270 ;289-290 Vendor Software Update
  1.  S ABMR(1,270)="P0"
  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. DIQ2 ;GET LOCATION INFORMATION
  1.  Q:$D(ABM(9999999.06,DUZ(2)))
  1.  N I S DIQ="ABM",DIQ(0)="IE",DIC="^AUTTLOC(",DA=DUZ(2)
  1.  S DR=".01;.13;.14;.15;.16;.17;.21"
  1.  D EN^DIQ1 K DIQ
  1.  Q