ABME570A ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 70-1 (Medical) cont'd ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;
;
; IHS/SD/SDR - v2.6 CSV
;
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, 1-2
S ABMR(70,10)=70
Q
;
20 ;Sequence , 3-4
S ABMR(70,20)="01"
Q
;
30 ;Patient Control Number, 5-24 (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, 25-30 (SOURCE: FILE=9002274.4017 FIELD=.01)
; from locator #67
D GET17
S ABMR(70,40)=ABM(17,1)
S ABMR(70,40)=$$FMT^ABMERUTL(ABMR(70,40),6)
Q
;
50 ;Other Diagnosis Code #1, 31-36 (SOURCE: FILE=9002274.4017, FIELD=.01)
; from locator #68
D GET17
S ABMR(70,50)=ABM(17,2)
S ABMR(70,50)=$$FMT^ABMERUTL(ABMR(70,50),6)
Q
;
60 ;Other Diagnosis Code #2, 37-42 (SOURCE: FILE=9002274.4017, FIELD=.01)
; from locator #69
D GET17
S ABMR(70,60)=ABM(17,3)
S ABMR(70,60)=$$FMT^ABMERUTL(ABMR(70,60),6)
Q
;
70 ;Other Diagnosis Code #3, 43-48 (SOURCE: FILE=9002274.4017, FIELD=.01)
; from locator #70
D GET17
S ABMR(70,70)=ABM(17,4)
S ABMR(70,70)=$$FMT^ABMERUTL(ABMR(70,70),6)
Q
;
80 ;Other Diagnosis Code #4, 49-54 (SOURCE: FILE=9002274.4017, FIELD=.01)
; from locator #71
D GET17
S ABMR(70,80)=ABM(17,5)
S ABMR(70,80)=$$FMT^ABMERUTL(ABMR(70,80),6)
Q
;
90 ;Other Diagnosis Code #5, 55-60 (SOURCE: FILE=9002274.4017, FIELD=.01)
; from locator #72
D GET17
S ABMR(70,90)=ABM(17,6)
S ABMR(70,90)=$$FMT^ABMERUTL(ABMR(70,90),6)
Q
;
100 ;Other Diagnosis Code #6, 61-66 (SOURCE: FILE=9002274.4017, FIELD=.01)
; from locator #73
D GET17
S ABMR(70,100)=ABM(17,7)
S ABMR(70,100)=$$FMT^ABMERUTL(ABMR(70,100),6)
Q
;
110 ;Other Diagnosis Code #7, 67-72 (SOURCE: FILE=9002274.4017, FIELD=.01)
; from locator #74
D GET17
S ABMR(70,110)=ABM(17,8)
S ABMR(70,110)=$$FMT^ABMERUTL(ABMR(70,110),6)
Q
;
120 ;Other Diagnosis Code #8, 73-78 (SOURCE: FILE=9002274.4017, FIELD=.01)
; from locator #75
D GET17
S ABMR(70,120)=ABM(17,9)
S ABMR(70,120)=$$FMT^ABMERUTL(ABMR(70,120),6)
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
..Q:$P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)'="E"
..S ABM(17,CNT)=$TR(ABM(17,CNT),".")
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
ABME570A ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 70-1 (Medical) cont'd ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;
+3 ;
+4 ; IHS/SD/SDR - v2.6 CSV
+5 ;
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-2
+1 SET ABMR(70,10)=70
+2 QUIT
+3 ;
20 ;Sequence , 3-4
+1 SET ABMR(70,20)="01"
+2 QUIT
+3 ;
30 ;Patient Control Number, 5-24 (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, 25-30 (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)=$$FMT^ABMERUTL(ABMR(70,40),6)
+5 QUIT
+6 ;
50 ;Other Diagnosis Code #1, 31-36 (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)=$$FMT^ABMERUTL(ABMR(70,50),6)
+5 QUIT
+6 ;
60 ;Other Diagnosis Code #2, 37-42 (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)=$$FMT^ABMERUTL(ABMR(70,60),6)
+5 QUIT
+6 ;
70 ;Other Diagnosis Code #3, 43-48 (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)=$$FMT^ABMERUTL(ABMR(70,70),6)
+5 QUIT
+6 ;
80 ;Other Diagnosis Code #4, 49-54 (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)=$$FMT^ABMERUTL(ABMR(70,80),6)
+5 QUIT
+6 ;
90 ;Other Diagnosis Code #5, 55-60 (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)=$$FMT^ABMERUTL(ABMR(70,90),6)
+5 QUIT
+6 ;
100 ;Other Diagnosis Code #6, 61-66 (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)=$$FMT^ABMERUTL(ABMR(70,100),6)
+5 QUIT
+6 ;
110 ;Other Diagnosis Code #7, 67-72 (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)=$$FMT^ABMERUTL(ABMR(70,110),6)
+5 QUIT
+6 ;
120 ;Other Diagnosis Code #8, 73-78 (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)=$$FMT^ABMERUTL(ABMR(70,120),6)
+5 QUIT
+6 ;
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 IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),1)),"^",5)'="E"
QUIT
+11 SET ABM(17,CNT)=$TRANSLATE(ABM(17,CNT),".")
End DoDot:2
End DoDot:1
+12 FOR I=1:1:9
IF '$DATA(ABM(17,I))
SET ABM(17,I)=""
+13 QUIT
+14 ;
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
