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