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

ABMER70A.m

Go to the documentation of this file. 
  1. ABMER70A ; IHS/ASDST/DMJ - UB92 EMC RECORD 70-1 (Medical) cont'd ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**8,17,19**;NOV 12, 2009;Build 300
  1.  ;Original;DMJ;
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p11 - NPI
  1.  ; IHS/SD/SDR - v2.5 p13 - POA changes
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;IHS/SD/SDR - 2.6*17 HEAT238640 - Removed decimal from DX for UB-04.  Was already removing it for all electronic formats.
  1.  ;   Also updated so DX fields will format to 7 characters instead of 6.
  1.  ;IHS/SD/SDR - 2.6*19 - HEAT116949 - Added check for 61044
  1.  ;
  1. LOOP ;LOOP HERE
  1.  F I=10:10:120 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),70,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(70)=$G(ABMREC(70))_ABMR(70,I)
  1.  Q
  1.  ;
  1. 10 ;Record type
  1.  S ABMR(70,10)=70
  1.  Q
  1.  ;
  1. 20 ;Sequence 
  1.  S ABMR(70,20)="01"
  1.  Q
  1.  ;
  1. 30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
  1.  S ABMR(70,30)=$$EX^ABMER20(30,ABMP("BDFN"))
  1.  S ABMR(70,30)=$$FMT^ABMERUTL(ABMR(70,30),20)
  1.  Q
  1.  ;
  1. 40 ;Principle Diagnosis Code (SOURCE: FILE=9002274.4017 FIELD=.01)
  1.  ; from locator #67
  1.  D GET17
  1.  S ABMR(70,40)=ABM(17,1)
  1.  S ABMR(70,40,"POA")=$G(ABM(17,1,"POA"))
  1.  ;S ABMR(70,40)=$$FMT^ABMERUTL(ABMR(70,40),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,40)=$$FMT^ABMERUTL(ABMR(70,40),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1.  ;
  1. 50 ;Other Diagnosis Code #1 (SOURCE: FILE=9002274.4017, FIELD=.01) 
  1.  ; from locator #68
  1.  D GET17
  1.  S ABMR(70,50)=ABM(17,2)
  1.  S ABMR(70,50,"POA")=$G(ABM(17,2,"POA"))
  1.  ;S ABMR(70,50)=$$FMT^ABMERUTL(ABMR(70,50),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,50)=$$FMT^ABMERUTL(ABMR(70,50),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1.  ;
  1. 60 ;Other Diagnosis Code #2 (SOURCE: FILE=9002274.4017, FIELD=.01)
  1.  ; from locator #69
  1.  D GET17
  1.  S ABMR(70,60)=ABM(17,3)
  1.  S ABMR(70,60,"POA")=$G(ABM(17,3,"POA"))
  1.  ;S ABMR(70,60)=$$FMT^ABMERUTL(ABMR(70,60),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,60)=$$FMT^ABMERUTL(ABMR(70,60),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1.  ;
  1. 70 ;Other Diagnosis Code #3 (SOURCE: FILE=9002274.4017, FIELD=.01)
  1.  ; from locator #70
  1.  D GET17
  1.  S ABMR(70,70)=ABM(17,4)
  1.  S ABMR(70,70,"POA")=$G(ABM(17,4,"POA"))
  1.  ;S ABMR(70,70)=$$FMT^ABMERUTL(ABMR(70,70),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,70)=$$FMT^ABMERUTL(ABMR(70,70),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1.  ;
  1. 80 ;Other Diagnosis Code #4 (SOURCE: FILE=9002274.4017, FIELD=.01)
  1.  ; from locator #71
  1.  D GET17
  1.  S ABMR(70,80)=ABM(17,5)
  1.  S ABMR(70,80,"POA")=$G(ABM(17,5,"POA"))
  1.  ;S ABMR(70,80)=$$FMT^ABMERUTL(ABMR(70,80),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,80)=$$FMT^ABMERUTL(ABMR(70,80),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1.  ;
  1. 90 ;Other Diagnosis Code #5 (SOURCE: FILE=9002274.4017, FIELD=.01)
  1.  ; from locator #72
  1.  D GET17
  1.  S ABMR(70,90)=ABM(17,6)
  1.  S ABMR(70,90,"POA")=$G(ABM(17,6,"POA"))
  1.  ;S ABMR(70,90)=$$FMT^ABMERUTL(ABMR(70,90),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,90)=$$FMT^ABMERUTL(ABMR(70,90),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1.  ;
  1. 100 ;Other Diagnosis Code #6 (SOURCE: FILE=9002274.4017, FIELD=.01)
  1.  ; from locator #73
  1.  D GET17
  1.  S ABMR(70,100)=ABM(17,7)
  1.  S ABMR(70,100,"POA")=$G(ABM(17,7,"POA"))
  1.  ;S ABMR(70,100)=$$FMT^ABMERUTL(ABMR(70,100),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,100)=$$FMT^ABMERUTL(ABMR(70,100),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1.  ;
  1. 110 ;Other Diagnosis Code #7 (SOURCE: FILE=9002274.4017, FIELD=.01)
  1.  ; from locator #74
  1.  D GET17
  1.  S ABMR(70,110)=ABM(17,8)
  1.  S ABMR(70,110,"POA")=$G(ABM(17,8,"POA"))
  1.  ;S ABMR(70,110)=$$FMT^ABMERUTL(ABMR(70,110),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,110)=$$FMT^ABMERUTL(ABMR(70,110),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1.  ;
  1. 120 ;Other Diagnosis Code #8 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  ; from locator #75
  1.  D GET17
  1.  S ABMR(70,120)=ABM(17,9)
  1.  S ABMR(70,120,"POA")=$G(ABM(17,9,"POA"))
  1.  ;S ABMR(70,120)=$$FMT^ABMERUTL(ABMR(70,120),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,120)=$$FMT^ABMERUTL(ABMR(70,120),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1. 130 ;Other Diagnosis Code #9 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  D GET17
  1.  S ABMR(70,130)=$G(ABM(17,10))
  1.  S ABMR(70,130,"POA")=$G(ABM(17,10,"POA"))
  1.  ;S ABMR(70,130)=$$FMT^ABMERUTL(ABMR(70,130),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,130)=$$FMT^ABMERUTL(ABMR(70,130),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1. 140 ;Other Diagnosis Code #10 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  D GET17
  1.  S ABMR(70,140)=$G(ABM(17,11))
  1.  S ABMR(70,140,"POA")=$G(ABM(17,11,"POA"))
  1.  ;S ABMR(70,140)=$$FMT^ABMERUTL(ABMR(70,140),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,140)=$$FMT^ABMERUTL(ABMR(70,140),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1. 150 ;Other Diagnosis Code #11 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  D GET17
  1.  S ABMR(70,150)=$G(ABM(17,12))
  1.  S ABMR(70,150,"POA")=$G(ABM(17,12,"POA"))
  1.  ;S ABMR(70,150)=$$FMT^ABMERUTL(ABMR(70,150),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,150)=$$FMT^ABMERUTL(ABMR(70,150),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1. 160 ;Other Diagnosis Code #12 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  D GET17
  1.  S ABMR(70,160)=$G(ABM(17,13))
  1.  S ABMR(70,160,"POA")=$G(ABM(17,13,"POA"))
  1.  ;S ABMR(70,160)=$$FMT^ABMERUTL(ABMR(70,160),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,160)=$$FMT^ABMERUTL(ABMR(70,160),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1. 170 ;Other Diagnosis Code #13 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  D GET17
  1.  S ABMR(70,170)=$G(ABM(17,14))
  1.  S ABMR(70,170,"POA")=$G(ABM(17,14,"POA"))
  1.  ;S ABMR(70,170)=$$FMT^ABMERUTL(ABMR(70,170),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,170)=$$FMT^ABMERUTL(ABMR(70,170),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1. 180 ;Other Diagnosis Code #14 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  D GET17
  1.  S ABMR(70,180)=$G(ABM(17,15))
  1.  S ABMR(70,180,"POA")=$G(ABM(17,15,"POA"))
  1.  ;S ABMR(70,180)=$$FMT^ABMERUTL(ABMR(70,180),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,180)=$$FMT^ABMERUTL(ABMR(70,180),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1. 190 ;Other Diagnosis Code #15 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  D GET17
  1.  S ABMR(70,190)=$G(ABM(17,16))
  1.  S ABMR(70,190,"POA")=$G(ABM(17,16,"POA"))
  1.  ;S ABMR(70,190)=$$FMT^ABMERUTL(ABMR(70,190),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,190)=$$FMT^ABMERUTL(ABMR(70,190),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1. 200 ;Other Diagnosis Code #16 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  D GET17
  1.  S ABMR(70,200)=$G(ABM(17,17))
  1.  S ABMR(70,200,"POA")=$G(ABM(17,17,"POA"))
  1.  ;S ABMR(70,200)=$$FMT^ABMERUTL(ABMR(70,200),6)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  S ABMR(70,200)=$$FMT^ABMERUTL(ABMR(70,200),7)  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  Q
  1.  ;
  1. GET17 ;GET DIAGNOSES CODES FROM BILL FILE
  1.  Q:$D(ABM(17))
  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.  ..;I ABMP("EXP")=21!(ABMP("EXP")=28) S ABM(17,CNT,"POA")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,J,0)),U,5)  ;abm*2.6*8 5010
  1.  ..I ABMP("EXP")=21!(ABMP("EXP")=28)!(ABMP("EXP")=31) S ABM(17,CNT,"POA")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,J,0)),U,5)  ;abm*2.6*8 5010
  1.  ..;Q:$P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)'="E"  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  ..;S ABM(17,CNT)=$TR(ABM(17,CNT),".")  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  1.  ..;I ($P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)="E")!((ABMP("EXP")=28)&($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,20)=30)) D  ;removing decimal for all electronic and UB-04  ;abm*2.6*17 IHS/SD/SDR HEAT238640  ;abm*2.6*19 IHS/SD/SDR HEAT116949
  1.  ..;start new abm*2.6*19 IHS/SD/SDR HEAT116949
  1.  ..I ($P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)="E")!((ABMP("EXP")=28)&($P($$DX^ABMCVAPI(J,ABMP("VDT")),U,20)=30))!($P($G(^ABMDEXP(ABMP("EXP"),1)),U,5)'="E"&($$RCID^ABMERUTL(ABMP("INS"))[61044)) D  ;remove decimal for all electronic, UB-04
  1.  ...;end new abm*2.6*19 IHS/SD/SDR HEAT116949
  1.  ...S ABM(17,CNT)=$TR(ABM(17,CNT),".")  ;abm*2.6*17 IHS/SD/SDR HEAT238640
  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(70,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(70,ABMX),ABMX,ABMY
  1.  Q Y