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

ABME3AA0.m

Go to the documentation of this file. 
  1. ABME3AA0 ; IHS/ASDST/DMJ - HCFA-1500 NSF 3.01 EMC RECORD AA0 (Submitter Data) ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/ASDS/DMJ - 09/06/01 - V2.4 Patch 7 - NOIS HQW-0701-100066
  1.  ;      This is a new routine related to Medicare Part B.
  1.  ;
  1.  ; IHS/ASDS/DMJ - 01/03/02 - V2.4 Patch 10 - NOIS NDA-1201-180141
  1.  ;     Modified code to calculate submission number differently as
  1.  ;     Medicare saves the numbers for up to a year.
  1.  ;
  1.  ; *********************************************************************
  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:330 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(^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)="" 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)=$P($G(^ABMDTXST(DUZ(2),+$G(ABMP("XMIT")),1)),"^",6)
  1.  I ABMR(1,50)="" D
  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.  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)="C"
  1.  Q
  1. 190 ;244-248 Version Code-National
  1.  S ABMR(1,190)="00301"
  1.  Q
  1. 200 ;249-253 Version Code-Local
  1.  S ABMR(1,200)="00301"
  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-291 Coordination of Benefits File Indicator
  1.  S ABMR(1,280)=""
  1.  S ABMR(1,280)=$$FMT^ABMERUTL(ABMR(1,280),1)
  1.  Q
  1. 290 ;292-299 Process from Date
  1.  S ABMR(1,290)=""
  1.  S ABMR(1,290)=$$FMT^ABMERUTL(ABMR(1,290),8)
  1.  Q
  1. 300 ;300-307 Process thru Date
  1.  S ABMR(1,300)=""
  1.  S ABMR(1,300)=$$FMT^ABMERUTL(ABMR(1,300),8)
  1.  Q
  1. 310 ;308-308 Acknowledgement Requested
  1.  S ABMR(1,310)=""
  1.  S ABMR(1,310)=$$FMT^ABMERUTL(ABMR(1,310),1)
  1.  Q
  1. 320 ;309-316 Date of Receipt
  1.  S ABMR(1,320)=""
  1.  S ABMR(1,320)=$$FMT^ABMERUTL(ABMR(1,320),8)
  1.  Q
  1. 330 ;317-320 Filler - National
  1.  S ABMR(1,330)=""
  1.  S ABMR(1,330)=$$FMT^ABMERUTL(ABMR(1,330),4)
  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