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

ABMEFA0.m

Go to the documentation of this file. 
  1. ABMEFA0 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD FA0 (Claim Root Segment) ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20395
  1.  ;  Split out lines bundled by rev code
  1.  ;
  1. START ;START HERE
  1.  K ABMR(61)
  1.  S ABME("S#")=0
  1.  D SET^ABMERUTL
  1.  K ABMP("FLAT") D FRATE^ABMDF11
  1.  D ^ABMEHGRV
  1.  D LOOP
  1.  K ABM,ABME,ABMRV
  1.  Q
  1. LOOP ;LOOP HERE
  1.  S J=0 F  S J=$O(ABMRV(J)) Q:'J  D
  1.  .S K=0 F  S K=$O(ABMRV(J,K)) Q:K=""  D
  1.  ..S M=0
  1.  ..F  S M=$O(ABMRV(J,K,M)) Q:M=""  D
  1.  ...K ABMREC(61)
  1.  ...S ABME("S#")=ABME("S#")+1
  1.  ...F I=10:10:500 D
  1.  ....D @I
  1.  ....I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),61,I)) D @(^(I))
  1.  ....D ADD
  1.  ...Q:J=9999
  1.  ...S ABM("ACTOT")=+$P(ABMRV(J,K,M),U,6)
  1.  ...S ABM("NCTOT")=+$P(ABMRV(J,K,M),U,7)
  1.  ...D ADTT^ABMER60
  1.  ...S ABMEF("LINE")=ABMREC(61)
  1.  ...D WRITE^ABMEF19
  1.  ...S ABME("RTYPE")=61 D S90^ABMERUTL
  1.  ...S ABMRT(95,"LTOT")=+$G(ABMRT(95,"LTOT"))+1
  1.  ...I J=23,'$G(ABMP("FLAT")) D ^ABMEFB0
  1.  Q
  1. ADD ;ADD TO RECORD
  1.  I '$G(ABMP("NOFMT")) S ABMREC(61)=$G(ABMREC(61))_ABMR(61,I)
  1.  Q
  1. 10 ;1-3 Record type
  1.  S ABMR(61,10)="FA0"
  1.  Q
  1. 20 ;4-5 Sequence 
  1.  S ABMR(61,20)=ABME("S#")
  1.  S ABMR(61,20)=$$FMT^ABMERUTL(ABMR(61,20),"2NR")
  1.  Q
  1. 30 ;6-22 Patient Control Number
  1.  S ABMR(61,30)=ABMP("PCN")
  1.  S ABMR(61,30)=$$FMT^ABMERUTL(ABMR(61,30),17)
  1.  Q
  1. 40 ;23-39 Line Item Control #
  1.  S ABMR(61,40)=""
  1.  S ABMR(61,40)=$$FMT^ABMERUTL(ABMR(61,40),17)
  1.  Q
  1. 50 ;40-47 Service Date From
  1.  S ABMR(61,50)=$P(ABMRV(J,K,M),U,10)
  1.  S:ABMR(61,50)="" ABMR(61,50)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
  1.  S ABMR(61,50)=$$Y2KD2^ABMDUTL(ABMR(61,50))
  1.  S ABMR(61,50)=$$FMT^ABMERUTL(ABMR(61,50),8)
  1.  Q
  1. 60 ;48-55 Service Date To
  1.  S ABMR(61,60)=$P(ABMRV(J,K,M),U,10)
  1.  S:ABMR(61,60)="" ABMR(61,60)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",2)
  1.  S ABMR(61,60)=$$Y2KD2^ABMDUTL(ABMR(61,60))
  1.  S ABMR(61,60)=$$FMT^ABMERUTL(ABMR(61,60),8)
  1.  Q
  1. 70 ;56-57 Place of Service Code
  1.  S ABMR(61,70)=$$POS^ABMERUTL
  1.  S ABMR(61,70)=$$FMT^ABMERUTL(ABMR(61,70),2)
  1.  Q
  1. 80 ;58-59 Type of Service Code
  1.  S ABMR(61,80)=$$TOS^ABMERUTL(J)
  1.  S ABMR(61,80)=$$FMT^ABMERUTL(ABMR(61,80),2)
  1.  Q
  1. 90 ;60-64 HCPCS Procedure Code
  1.  S ABMR(61,90)=$P(ABMRV(J,K,M),U,2)
  1.  S ABMR(61,90)=$$FMT^ABMERUTL(ABMR(61,90),5)
  1.  Q
  1. 100 ;65-66 Modifier 1
  1.  S ABMR(61,100)=$P(ABMRV(J,K,M),U,3)
  1.  S ABMR(61,100)=$$FMT^ABMERUTL(ABMR(61,100),2)
  1.  Q
  1. 110 ;67-68 Modifier 2
  1.  S ABMR(61,110)=$P(ABMRV(J,K,M),U,4)
  1.  S ABMR(61,110)=$$FMT^ABMERUTL(ABMR(61,110),2)
  1.  Q
  1. 120 ;69-70 Modifier 3
  1.  S ABMR(61,120)=""
  1.  S ABMR(61,120)=$$FMT^ABMERUTL(ABMR(61,120),2)
  1.  Q
  1. 130 ;71-77 Line Charges
  1.  S ABMR(61,130)=$P(ABMRV(J,K,M),U,6)
  1.  S ABMRT(90,"DTOT")=+$G(ABMRT(90,"DTOT"))+ABMR(61,130)
  1.  S ABMR(61,130)=$$FMT^ABMERUTL(ABMR(61,130),"7NRJ2")
  1.  Q
  1. 140 ;78-78 Diag Code Pointer 1
  1.  S ABMCDX=$P(ABMRV(J,K,M),U,11)
  1.  S:ABMCDX="" ABMCDX=1
  1.  S ABMR(61,140)=$P(ABMCDX,",",1)
  1.  S ABMR(61,140)=$$FMT^ABMERUTL(ABMR(61,140),1)
  1.  Q
  1. 150 ;79-79 Diag Code Pointer 2
  1.  S ABMR(61,150)=$P(ABMCDX,",",2)
  1.  S ABMR(61,150)=$$FMT^ABMERUTL(ABMR(61,150),1)
  1.  Q
  1. 160 ;80-80 Diag Code Pointer 3
  1.  S ABMR(61,160)=$P(ABMCDX,",",3)
  1.  S ABMR(61,160)=$$FMT^ABMERUTL(ABMR(61,160),1)
  1.  Q
  1. 170 ;81-81 Diag Code Pointer 4
  1.  S ABMR(61,170)=$P(ABMCDX,",",4)
  1.  S ABMR(61,170)=$$FMT^ABMERUTL(ABMR(61,170),1)
  1.  K ABMCDX
  1.  Q
  1. 180 ;82-85 Units of Service
  1.  S ABMR(61,180)=$P(ABMRV(J,K,M),U,5)
  1.  S ABMR(61,180)=$$FMT^ABMERUTL(ABMR(61,180),"4NRJ1")
  1.  Q
  1. 190 ;86-89 Anesthesia/Oxygen Min
  1.  S ABMR(61,190)=""
  1.  S ABMR(61,190)=$$FMT^ABMERUTL(ABMR(61,190),"4NR")
  1.  Q
  1. 200 ;90-90 Emergency Ind
  1.  S ABMR(61,200)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",5)
  1.  S:ABMR(61,200)="" ABMR(61,200)="N"
  1.  S ABMR(61,200)=$$FMT^ABMERUTL(ABMR(61,200),1)
  1.  Q
  1. 210 ;91-91 COB Ind
  1.  S ABMR(61,210)=""
  1.  S ABMR(61,210)=$$FMT^ABMERUTL(ABMR(61,210),1)
  1.  Q
  1. 220 ;92-92 HPSA Ind
  1.  S ABMR(61,220)=""
  1.  S ABMR(61,220)=$$FMT^ABMERUTL(ABMR(61,220),1)
  1.  Q
  1. 230 ;93-107 Rendering Prov ID     
  1.  S ABMR(61,230)=""
  1.  S ABMR(61,230)=$$FMT^ABMERUTL(ABMR(61,230),15)
  1.  Q
  1. 240 ;108-122 Referring Prov ID
  1.  S ABMR(61,240)=""
  1.  S ABMR(61,240)=$$FMT^ABMERUTL(ABMR(61,240),15)
  1.  Q
  1. 250 ;123-124 Referring Prov State
  1.  S ABMR(61,250)=""
  1.  S ABMR(61,250)=$$FMT^ABMERUTL(ABMR(61,250),2)
  1.  Q
  1. 260 ;125-125 Pur Svc Ind
  1.  S ABMR(61,260)=""
  1.  S ABMR(61,260)=$$FMT^ABMERUTL(ABMR(61,260),1)
  1.  Q
  1. 270 ;126-132 Disallowed Cost Cont
  1.  S ABMR(61,270)=""
  1.  S ABMR(61,270)=$$FMT^ABMERUTL(ABMR(61,270),"7NRJ2")
  1.  Q
  1. 280 ;133-139 Disallowed Other
  1.  S ABMR(61,280)=""
  1.  S ABMR(61,280)=$$FMT^ABMERUTL(ABMR(61,280),"7NRJ2")
  1.  Q
  1. 290 ;140-140 Review By Code Ind
  1.  S ABMR(61,290)=""
  1.  S ABMR(61,290)=$$FMT^ABMERUTL(ABMR(61,290),1)
  1.  Q
  1. 300 ;141-141 Multi Procedure Ind
  1.  S ABMR(61,300)=""
  1.  S ABMR(61,300)=$$FMT^ABMERUTL(ABMR(61,300),1)
  1.  Q
  1. 310 ;142-151 Mammography Cert No
  1.  S ABMR(61,310)=""
  1.  S ABMR(61,310)=$$FMT^ABMERUTL(ABMR(61,310),10)
  1.  Q
  1. 320 ;152-160 Class Findings
  1.  S ABMR(61,320)=""
  1.  S ABMR(61,320)=$$FMT^ABMERUTL(ABMR(61,320),9)
  1.  Q
  1. 330 ;161-163 Podiatry Svc Cond
  1.  S ABMR(61,330)=""
  1.  S ABMR(61,330)=$$FMT^ABMERUTL(ABMR(61,330),3)
  1.  Q
  1. 340 ;164-178 CLIA ID #
  1.  S ABMR(61,340)=""
  1.  S ABMR(61,340)=$$FMT^ABMERUTL(ABMR(61,340),15)
  1.  Q
  1. 350 ;179-185 Primary Paid Amount (Other Insurance)
  1.  S ABMR(61,350)=""
  1.  S ABMR(61,350)=$$FMT^ABMERUTL(ABMR(61,350),"7NRJ2")
  1.  Q
  1. 360 ;186-187 HCPCS Modifier 4
  1.  S ABMR(61,360)=""
  1.  S ABMR(61,360)=$$FMT^ABMERUTL(ABMR(61,360),2)
  1.  Q
  1. 370 ;188-190 Provider Specialty
  1.  S ABMR(61,370)=""
  1.  S ABMR(61,370)=$$FMT^ABMERUTL(ABMR(61,370),3)
  1.  Q
  1. 380 ;191-191 Podiatry Therapy Ind     
  1.  S ABMR(61,380)=""
  1.  S ABMR(61,380)=$$FMT^ABMERUTL(ABMR(61,380),1)
  1.  Q
  1. 390 ;192-192 Podiatry Therapy Type
  1.  S ABMR(61,390)=""
  1.  S ABMR(61,390)=$$FMT^ABMERUTL(ABMR(61,390),1)
  1.  Q
  1. 400 ;193-193 Hospice Employed Prov Ind
  1.  S ABMR(61,400)=""
  1.  S ABMR(61,400)=$$FMT^ABMERUTL(ABMR(61,400),1)
  1.  Q
  1. 410 ;194-201 HGB/HCT Date
  1.  S ABMR(61,410)=""
  1.  S ABMR(61,410)=$$FMT^ABMERUTL(ABMR(61,410),8)
  1.  Q
  1. 420 ;202-204 HGB Result
  1.  S ABMR(61,420)=""
  1.  S ABMR(61,420)=$$FMT^ABMERUTL(ABMR(61,420),"3NR")
  1.  Q
  1. 430 ;205-206 HCT Result
  1.  S ABMR(61,430)=""
  1.  S ABMR(61,430)=$$FMT^ABMERUTL(ABMR(61,430),"2NR")
  1.  Q
  1. 440 ;207-209 Patient Weight
  1.  S ABMR(61,440)=""
  1.  S ABMR(61,440)=$$FMT^ABMERUTL(ABMR(61,440),"3NR")
  1.  Q
  1. 450 ;210-212 EPO Dosage
  1.  S ABMR(61,450)=""
  1.  S ABMR(61,450)=$$FMT^ABMERUTL(ABMR(61,450),"3NR")
  1.  Q
  1. 460 ;213-220 Serum Creatine Date
  1.  S ABMR(61,460)=""
  1.  S ABMR(61,460)=$$FMT^ABMERUTL(ABMR(61,460),8)
  1.  Q
  1. 470 ;221-223 Creatine Result
  1.  S ABMR(61,470)=""
  1.  S ABMR(61,470)=$$FMT^ABMERUTL(ABMR(61,470),"3NR")
  1.  Q
  1. 480 ;224-230 Obligated Accept Amt
  1.  S ABMR(61,480)=""
  1.  S ABMR(61,480)=$$FMT^ABMERUTL(ABMR(61,480),"7NRJ2")
  1.  Q
  1. 490 ;231-237 Drug Discount Amt
  1.  S ABMR(61,490)=""
  1.  S ABMR(61,490)=$$FMT^ABMERUTL(ABMR(61,490),"7NRJ2")
  1.  Q
  1. 500 ;238-320 Filler (National)
  1.  S ABMR(61,500)=""
  1.  S ABMR(61,500)=$$FMT^ABMERUTL(ABMR(61,500),83)
  1.  Q
  1. EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
  1.  ;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(61,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(61,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
  1.  Q Y