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

ABMEH40.m

Go to the documentation of this file. 
  1. ABMEH40 ; IHS/ASDST/DMJ - HFCA-1500 EA0 (Claim Record) ;     
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
  1.  ;Original;DMJ;
  1.  ;
  1.  ; IHS/ASDS/DMJ - 09/07/00 - V2.4 Patch 3 - NOIS HQW-0900-100015
  1.  ;     Strip special characters for electronic HCFA-1500 claims
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
  1.  ;
  1. START ;start here
  1.  K ABMREC(40),ABMR(40),ABM,ABME
  1.  S ABME("RTYPE")=40
  1.  D SET^ABMERUTL
  1.  D LOOP
  1.  D S90^ABMERUTL
  1.  K ABM,ABME
  1.  Q
  1. LOOP ;LOOP HERE
  1.  F I=10:10:500 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),40,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(40)=$G(ABMREC(40))_ABMR(40,I)
  1.  Q
  1.  ;
  1. 10 ;1-3 Record ID
  1.  S ABMR(40,10)="EA0"
  1.  Q
  1. 20 ;4-5 Reserved
  1.  S ABMR(40,20)=""
  1.  S ABMR(40,20)=$$FMT^ABMERUTL(ABMR(40,20),2)
  1.  Q
  1.  ;
  1. 30 ;6-22 Patient Control Number
  1.  S ABMR(40,30)=ABMP("PCN")
  1.  S ABMR(40,30)=$$FMT^ABMERUTL(ABMR(40,30),17)
  1.  Q
  1. 40 ;23-23 Empl Related Ind
  1.  S ABMR(40,40)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U)
  1.  S:ABMR(40,40)'="Y" ABMR(40,40)="N"
  1.  Q
  1. 50 ;24-24 Accident Ind
  1.  S ABMR(40,50)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",3)
  1.  I 'ABMR(40,50) S ABMR(40,50)="N" Q
  1.  I ABMR(40,50)<3 S ABMR(40,50)="A" Q
  1.  S ABMR(40,50)="O"
  1.  Q
  1. 60 ;25-25 Symptom Ind
  1.  S ABMR(40,60)=0
  1.  I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",6) S ABMR(40,60)=1
  1.  Q
  1. 70 ;26-33 Accident/Symptom Date
  1.  S ABMR(40,70)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",2)
  1.  I ABMR(40,70) S ABMR(40,70)=$$Y2KD2^ABMDUTL(ABMR(40,70)) Q
  1.  S ABMR(40,70)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",6)
  1.  S ABMR(40,70)=$$Y2KD2^ABMDUTL(ABMR(40,70))
  1.  S ABMR(40,70)=$$FMT^ABMERUTL(ABMR(40,70),8)
  1.  Q
  1. 80 ;34-38 Ext Cause OF Accident
  1.  S ABMR(40,80)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,12)
  1.  ;S:ABMR(40,80) ABMR(40,80)=$P($$DX^ABMCVAPI(ABMR(40,80),ABMP("VDT")),U,2)  ;CSV-c  ;abm*2.6*14 updated API call
  1.  S:ABMR(40,80) ABMR(40,80)=$P($$DX^ABMCVAPI(+ABMR(40,80),ABMP("VDT")),U,2)  ;CSV-c  ;abm*2.6*14 updated API call
  1.  S ABMR(40,80)=$TR(ABMR(40,80),".")
  1.  S ABMR(40,80)=$$FMT^ABMERUTL(ABMR(40,80),5)
  1.  Q
  1. 90 ;39-39 Responsibility Ind
  1.  S ABMR(40,90)=""
  1.  S ABMR(40,90)=$$FMT^ABMERUTL(ABMR(40,90),1)
  1.  Q
  1. 100 ;40-41 Accident State     
  1.  S ABMR(40,100)=""
  1.  S ABMR(40,100)=$$FMT^ABMERUTL(ABMR(40,100),2)
  1.  Q
  1. 110 ;42-43 Accident Hour
  1.  S ABMR(40,110)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",4)
  1.  S ABMR(40,110)=$$FMT^ABMERUTL(ABMR(40,110),"2NR")
  1.  Q
  1. 120 ;44-44 Abuse Ind
  1.  S ABMR(40,120)=""
  1.  S ABMR(40,120)=$$FMT^ABMERUTL(ABMR(40,120),1)
  1.  Q
  1. 130 ;45-45 Release if Info Ind
  1.  S ABMR(40,130)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",4)
  1.  S:ABMR(40,130)="R" ABMR(40,130)="M"
  1.  S ABMR(40,130)=$$FMT^ABMERUTL(ABMR(40,130),1)
  1.  Q
  1. 140 ;46-53 Release of Info Date
  1.  S ABMR(40,140)=$P($G(^AUPNPAT(ABMP("PDFN"),0)),"^",4)
  1.  S ABMR(40,140)=$$Y2KD2^ABMDUTL(ABMR(40,140))
  1.  S ABMR(40,140)=$$FMT^ABMERUTL(ABMR(40,140),8)
  1.  Q
  1. 150 ;54-54 Same/Similar Symp Ind
  1.  S ABMR(40,150)=""
  1.  D 160
  1.  S:ABMR(40,160) ABMR(40,150)="Y"
  1.  S ABMR(40,150)=$$FMT^ABMERUTL(ABMR(40,150),1)
  1.  Q
  1. 160 ;55-62 Same/Similar Symp Date
  1.  S ABMR(40,160)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",9)
  1.  S:ABMR(40,160) ABMR(40,160)=$$Y2KD2^ABMDUTL(ABMR(40,160))
  1.  S ABMR(40,160)=$$FMT^ABMERUTL(ABMR(40,160),8)
  1.  Q
  1. 170 ;63-63 Disability Type
  1.  S ABMR(40,170)=""
  1.  S ABMR(40,170)=$$FMT^ABMERUTL(ABMR(40,170),1)
  1.  Q
  1. 180 ;64-71 Disability From Date
  1.  S ABMR(40,180)=""
  1.  S ABMR(40,180)=$$FMT^ABMERUTL(ABMR(40,180),8)
  1.  Q
  1. 190 ;72-79 Disability To Date
  1.  S ABMR(40,190)=""
  1.  S ABMR(40,190)=$$FMT^ABMERUTL(ABMR(40,190),8)
  1.  Q
  1. 200 ;80-94 Refer Prov ID #
  1.  S ABMR(40,200)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",11)
  1.  S ABMR(40,200)=$$FMT^ABMERUTL(ABMR(40,200),"15S")
  1.  Q
  1. 210 ;95-119 Reserved
  1.  S ABMR(40,210)=""
  1.  S ABMR(40,210)=$$FMT^ABMERUTL(ABMR(40,210),25)
  1.  Q
  1. 220 ;120-139 Refer Prov Last     
  1.  S ABMR(40,220)=""
  1.  K ABMRPM,ABMRPF
  1.  S ABMRP=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",8)
  1.  I ABMRP[",",$F(ABMRP,",")<$F(ABMRP," ") D
  1.  .S ABMR(40,220)=$P(ABMRP,",",1)
  1.  .S ABMRPF=$P(ABMRP,",",2)
  1.  .S ABMRPM=$P(ABMRPF," ",2)
  1.  .S ABMRPM=$E(ABMRPM)
  1.  .S ABMRPF=$P(ABMRPF," ",1)
  1.  I ABMRP'="",'$D(ABMRPF) D
  1.  .S ABMRP=$P(ABMRP,",",1)
  1.  .S ABMRPF=$P(ABMRP," ",1)
  1.  .I $L(ABMRP," ")>2 S ABMRPM=$E($P(ABMRP," ",2))
  1.  .S ABMR(40,220)=$P(ABMRP," ",$L(ABMRP," "))
  1.  S ABMR(40,220)=$$FMT^ABMERUTL(ABMR(40,220),20)
  1.  Q
  1. 230 ;140-151 Refer Prov First
  1.  S ABMR(40,230)=$G(ABMRPF)
  1.  S ABMR(40,230)=$$FMT^ABMERUTL(ABMR(40,230),12)
  1.  Q
  1. 240 ;152-152 Refer Prov MI
  1.  S ABMR(40,240)=$G(ABMRPM)
  1.  S ABMR(40,240)=$$FMT^ABMERUTL(ABMR(40,240),1)
  1.  Q
  1. 250 ;153-154 Refer Prov State
  1.  S ABMR(40,250)=""
  1.  S ABMR(40,250)=$$FMT^ABMERUTL(ABMR(40,250),2)
  1.  Q
  1. 260 ;155-162 Admission Date
  1.  S ABMR(40,260)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U)
  1.  S ABMR(40,260)=$$Y2KD2^ABMDUTL(ABMR(40,260))
  1.  S ABMR(40,260)=$$FMT^ABMERUTL(ABMR(40,260),8)
  1.  Q
  1. 270 ;163-170 Discharge Date
  1.  S ABMR(40,270)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),"^",3)
  1.  S ABMR(40,270)=$$Y2KD2^ABMDUTL(ABMR(40,270))
  1.  S ABMR(40,270)=$$FMT^ABMERUTL(ABMR(40,270),8)
  1.  Q
  1. 280 ;171-171 Lab Ind
  1.  S ABMR(40,280)="N"
  1.  D 290
  1.  S:ABMR(40,290) ABMR(40,280)="Y"
  1.  S ABMR(40,280)=$$FMT^ABMERUTL(ABMR(40,280),1)
  1.  Q
  1. 290 ;172-178 Lab Charges
  1.  S ABMR(40,290)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U)
  1.  S ABMR(40,290)=$$FMT^ABMERUTL(ABMR(40,290),"7NRJ2")
  1.  Q
  1. 300 ;179-183 Diagnosis Code 1
  1.  D GET17
  1.  S ABMR(40,300)=ABM(17,1)
  1.  S ABMR(40,300)=$$FMT^ABMERUTL(ABMR(40,300),5)
  1.  Q
  1. 310 ;184-188 Diagnosis Code 2
  1.  S ABMR(40,310)=ABM(17,2)
  1.  S ABMR(40,310)=$$FMT^ABMERUTL(ABMR(40,310),5)
  1.  Q
  1. 320 ;189-193 Diagnosis Code 3
  1.  S ABMR(40,320)=ABM(17,3)
  1.  S ABMR(40,320)=$$FMT^ABMERUTL(ABMR(40,320),5)
  1.  Q
  1. 330 ;194-198 Diagnosis Code 4
  1.  S ABMR(40,330)=ABM(17,4)
  1.  S ABMR(40,330)=$$FMT^ABMERUTL(ABMR(40,330),5)
  1.  Q
  1. 340 ;199-199 Prov Assign Ind
  1.  S ABMR(40,340)=""
  1.  S ABMR(40,340)=$$FMT^ABMERUTL(ABMR(40,340),1)
  1.  Q
  1. 350 ;200-200 Prov Signature Ind
  1.  S ABMR(40,350)="Y"
  1.  S ABMR(40,350)=$$FMT^ABMERUTL(ABMR(40,350),1)
  1.  Q
  1. 360 ;201-208 Prov Signature Date
  1.  S ABMR(40,360)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),"^",5)
  1.  S ABMR(40,360)=ABMR(40,360)\1
  1.  S ABMR(40,360)=$$Y2KD2^ABMDUTL(ABMR(40,360))
  1.  S ABMR(40,360)=$$FMT^ABMERUTL(ABMR(40,360),8)
  1.  Q
  1. 370 ;209-241 Facility/Lab Name
  1.  S ABMR(40,370)=$P(^DIC(4,DUZ(2),0),U)
  1.  S ABMR(40,370)=$$FMT^ABMERUTL(ABMR(40,370),33)
  1.  Q
  1. 380 ;242-242 Documentation Ind
  1.  S ABMR(40,380)=""
  1.  S ABMR(40,380)=$$FMT^ABMERUTL(ABMR(40,380),1)
  1.  Q
  1. 390 ;243-243 Type of Documentation
  1.  S ABMR(40,390)=""
  1.  S ABMR(40,390)=$$FMT^ABMERUTL(ABMR(40,390),1)
  1.  Q
  1. 400 ;244-245 Functnl Status Code
  1.  S ABMR(40,400)=""
  1.  S ABMR(40,400)=$$FMT^ABMERUTL(ABMR(40,400),2)
  1.  Q
  1. 410 ;246-247 Special Program Ind
  1.  S ABMR(40,410)=""
  1.  S ABMR(40,410)=$$FMT^ABMERUTL(ABMR(40,410),2)
  1.  Q
  1. 420 ;248-248 Champus Nonavail Ind
  1.  S ABMR(40,420)=""
  1.  S ABMR(40,420)=$$FMT^ABMERUTL(ABMR(40,420),1)
  1.  Q
  1. 430 ;249-249 Supv Prov Ind
  1.  S ABMR(40,430)=""
  1.  S ABMR(40,430)=$$FMT^ABMERUTL(ABMR(40,430),1)
  1.  Q
  1. 440 ;250-251 Resubmission Code
  1.  S ABMR(40,440)=""
  1.  D 450
  1.  I ABMR(40,450)'?15" " D
  1.  .S ABMR(40,440)="01"
  1.  .S:$$RCID^ABMERUTL(ABMP("INS"))=99999 ABMR(40,440)="A"
  1.  S ABMR(40,440)=$$FMT^ABMERUTL(ABMR(40,440),2)
  1.  Q
  1. 450 ;252-266 Resub Reference #
  1.  S ABMR(40,450)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),"^",9)
  1.  S ABMR(40,450)=$$FMT^ABMERUTL(ABMR(40,450),15)
  1.  Q
  1. 460 ;267-274 Date Last Seen
  1.  S ABMR(40,460)=""
  1.  S ABMR(40,460)=$$FMT^ABMERUTL(ABMR(40,460),8)
  1.  Q
  1. 470 ;275-282 Date Document Sent
  1.  S ABMR(40,470)=""
  1.  S ABMR(40,470)=$$FMT^ABMERUTL(ABMR(40,470),8)
  1.  Q
  1. 480 ;283-283 Homebound Ind
  1.  S ABMR(40,480)=""
  1.  S ABMR(40,480)=$$FMT^ABMERUTL(ABMR(40,480),1)
  1.  Q
  1. 490 ;284-293 Filler (National)
  1.  S ABMR(40,490)=""
  1.  S ABMR(40,490)=$$FMT^ABMERUTL(ABMR(40,490),10)
  1.  Q
  1. 500 ;294-320 Filler (Local)
  1.  S ABMR(40,500)=""
  1.  S ABMR(40,500)=$$FMT^ABMERUTL(ABMR(40,500),27)
  1.  Q
  1. GET17 ;GET DIAGNOSES CODES FROM BILL FILE
  1.  N I,J
  1.  S I=0,CNT=0
  1.  F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I)) Q:'I  D
  1.  .S J=0
  1.  .F  S J=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I,J)) Q:'J  D
  1.  ..S CNT=CNT+1
  1.  ..S ABM(17,CNT)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,J,0),U) ; ICD Diagnosis IEN
  1.  ..S ABM(17,CNT)=$P($$DX^ABMCVAPI(+ABM(17,CNT),ABMP("VDT")),U,2) ; ICD Diagnosis code  ;CSV-c
  1.  ..Q:$P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)="H"
  1.  ..S ABM(17,CNT)=$TR(ABM(17,CNT),".")
  1.  F I=1:1:9 S:'$D(ABM(17,I)) ABM(17,I)=""
  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.  I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
  1.  D @ABMX
  1.  S Y=ABMR(40,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(40,ABMX),ABMX,ABMY
  1.  Q Y