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

ABMEH15.m

Go to the documentation of this file. 
  1. ABMEH15 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD BA1 (Provider) ;     
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/ASDS/DMJ - 04/18/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
  1.  ;     Modified location code to check for satellite first.  If no
  1.  ;     satellite, use parent.
  1.  ; IHS/ASDS/DMJ - 08/30/00 - V2.4 Patch 3 - NOIS HQW-0800-100133
  1.  ;     Modified to check provider number under DUZ(2) if missing
  1.  ;     ABMP("LDFN")
  1.  ;
  1. START ;START HERE
  1.  K ABMREC(15),ABMR(15)
  1.  S ABME("RTYPE")=15
  1.  D LOOP
  1.  S ABMRT(95,"RTOT")=ABMRT(95,"RTOT")+1
  1.  K ABME,ABM
  1.  Q
  1.  ;
  1. LOOP ;LOOP HERE
  1.  F I=10:10:200 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),15,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(15)=$G(ABMREC(15))_ABMR(15,I)
  1.  Q
  1.  ;
  1. 10 ;Record type
  1.  S ABMR(15,10)="BA1"
  1.  Q
  1. 20 ;4-18 EMC Provider ID
  1.  S ABMR(15,20)=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
  1.  S:ABMR(15,20)="" ABMR(15,20)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)
  1.  S:ABMR(15,20)="" ABMR(15,20)=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),"^",2)
  1.  S:$$RCID^ABMERUTL(ABMP("INS"))=99999 ABMR(15,20)="00"_ABMR(15,20) ;TMJ changed and tested
  1.  S ABMR(15,20)=$$FMT^ABMERUTL(ABMR(15,20),15)
  1.  Q
  1. 30 ;19-21 Type of Batch
  1.  S ABMR(15,30)=100
  1.  I $$RCID^ABMERUTL(ABMP("INS"))'=99999 D
  1.  .S:ABMP("VTYP")=998 ABMR(15,30)=200
  1.  .S:ABMP("VTYP")=997 ABMR(15,30)=300
  1.  Q
  1.  ;
  1. 40 ;22-25 Batch Number
  1.  S ABMR(15,40)=$G(ABMEF("BATCH#"))
  1.  S ABMR(15,40)=$$FMT^ABMERUTL(ABMR(15,40),"4NR")
  1.  Q
  1. 50 ;26-31 Batch ID
  1.  S ABMR(15,50)=$G(ABMR(1,50))
  1.  S ABMR(15,50)=$$FMT^ABMERUTL(ABMR(15,50),6)
  1.  Q
  1. 60 ;32-34 Provider Type Org
  1.  S ABMR(15,60)=""
  1.  S ABMR(15,60)=$$FMT^ABMERUTL(ABMR(15,60),3)
  1.  Q
  1. 70 ;35-64 Prov Svc Addr 1
  1.  D DIQ1
  1.  S ABMR(15,70)=$G(ABM(9999999.06,DUZ(2),.14,"E"))
  1.  S ABMR(15,70)=$$FMT^ABMERUTL(ABMR(15,70),30)
  1.  Q
  1. 80 ;65-94 Prov Svc Addr2
  1.  S ABMR(15,80)=""
  1.  S ABMR(15,80)=$$FMT^ABMERUTL(ABMR(15,80),30)
  1.  Q
  1. 90 ;95-114 Prov Svc City
  1.  S ABMR(15,90)=$G(ABM(9999999.06,DUZ(2),.15,"E"))
  1.  S ABMR(15,90)=$$FMT^ABMERUTL(ABMR(15,90),20)
  1.  Q
  1. 100 ;115-116 Prov Svc State
  1.  S ABMR(15,100)=$G(ABM(9999999.06,DUZ(2),.16,"I"))
  1.  S ABMR(15,100)=$P($G(^DIC(5,+ABMR(15,100),0)),"^",2)
  1.  S ABMR(15,100)=$$FMT^ABMERUTL(ABMR(15,100),2)
  1.  Q
  1. 110 ;117-125 Prov Svc Zip     
  1.  S ABMR(15,110)=$G(ABM(9999999.06,DUZ(2),.17,"E"))
  1.  S ABMR(15,110)=$$FMT^ABMERUTL(ABMR(15,110),9)
  1.  Q
  1. 120 ;126-135 Prov Svc Phone
  1.  S ABMR(15,120)=$G(ABM(9999999.06,DUZ(2),.13,"E"))
  1.  S ABMR(15,120)=$TR(ABMR(15,120),"()- ")
  1.  S ABMR(15,120)=$$FMT^ABMERUTL(ABMR(15,120),10)
  1.  Q
  1. 130 ;136-165 Prov Pay To Addr1     
  1.  D DIQ2
  1.  S ABMR(15,130)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.14,"E"))
  1.  S ABMR(15,130)=$$FMT^ABMERUTL(ABMR(15,130),30)
  1.  Q
  1. 140 ;166-195 Prov Pay To Addr2
  1.  S ABMR(15,140)=""
  1.  S ABMR(15,140)=$$FMT^ABMERUTL(ABMR(15,140),30)
  1.  Q
  1. 150 ;196-215 Prov Pay To City
  1.  S ABMR(15,150)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.15,"E"))
  1.  S ABMR(15,150)=$$FMT^ABMERUTL(ABMR(15,150),20)
  1.  Q
  1. 160 ;216-217 Prov Pay To State
  1.  S ABMR(15,160)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.16,"I"))
  1.  S ABMR(15,160)=$P($G(^DIC(5,+ABMR(15,160),0)),"^",2)
  1.  S ABMR(15,160)=$$FMT^ABMERUTL(ABMR(15,160),2)
  1.  Q
  1. 170 ;218-226 Prov Pay To Zip
  1.  S ABMR(15,170)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.17,"E"))
  1.  S ABMR(15,170)=$$FMT^ABMERUTL(ABMR(15,170),9)
  1.  Q
  1. 180 ;227-236 Prov Pay To Phone
  1.  S ABMR(15,180)=$G(ABM(9999999.06,+ABMP("PAYDFN"),.13,"E"))
  1.  S ABMR(15,180)=$TR(ABMR(15,180),"()- ")
  1.  S ABMR(15,180)=$$FMT^ABMERUTL(ABMR(15,180),10)
  1.  Q
  1. 190 ;237-278 Filler (National Use)
  1.  S ABMR(15,190)=""
  1.  S ABMR(15,190)=$$FMT^ABMERUTL(ABMR(15,190),42)
  1.  Q
  1. 200 ;279-320 Filler (Local Use)
  1.  S ABMR(15,200)=""
  1.  S ABMR(15,200)=$$FMT^ABMERUTL(ABMR(15,200),42)
  1.  Q
  1. DIQ1 ;PULL LOCATION DATA VIA DIQ1
  1.  N I
  1.  S DIQ="ABM("
  1.  S DIQ(0)="IE"
  1.  S DIC="^AUTTLOC("
  1.  S DA=DUZ(2)
  1.  S DR=".01;.13;.14;.15;.16;.17;.21;.22"
  1.  D EN^DIQ1
  1.  Q
  1. DIQ2 ;pay to info
  1.  N I
  1.  S ABMP("PAYDFN")=$P($G(^ABMDPARM(DUZ(2),1,2)),"^",3)
  1.  Q:ABMP("PAYDFN")=""
  1.  Q:ABMP("PAYDFN")=DUZ(2)
  1.  S DA=ABMP("PAYDFN")
  1.  S DR=".01;.13;.14;.15;.16;.17;.21"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1. DIQ3 ;GET SITE PARAMETER INFO    
  1.  N I
  1.  S DIQ="ABM("
  1.  S DIQ(0)="E"
  1.  S DIC="^ABMDPARM(DUZ(2),"
  1.  S DA=1
  1.  S DR=.26
  1.  D EN^DIQ1 K DIQ
  1.  Q
  1.  ;
  1. EX(ABMX,ABMY) ;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),ABME,ABM,ABMX,ABMY
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  Q Y