ABME540A ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 40 (Claim Data) cont'd ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;
;
LOOP ;LOOP HERE
F I=10:10:170 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),40,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(40,ABME("S#"))=$G(ABMREC(40,ABME("S#")))_ABMR(40,I)
Q
;
10 ;Record type, 1-2
S ABMR(40,10)=40
Q
;
20 ;Sequence, 3-4
S ABMR(40,20)=ABME("S#")
S ABMR(40,20)=$$FMT^ABMERUTL(ABMR(40,20),"2RN")
Q
;
30 ;Patient Control Number, 5-24 (SOURCE: FILE=9000001.41,FIELD=.02)
S ABMR(40,30)=$$EX^ABMER20(30,ABMP("BDFN"))
S ABMR(40,30)=$$FMT^ABMERUTL(ABMR(40,30),20)
Q
;
40 ;Type of Bill, 25-27 (SOURCE: FILE=9002274.4 FIELD=.02)
S ABME("FLD")=.02
D DIQ1
S ABMR(40,40)=ABM(9002274.4,ABMP("BDFN"),.02,"E")
S ABMR(40,40)=$$FMT^ABMERUTL(ABMR(40,40),3)
Q
;
50 ;Treatment Authorization Code-A, 28-45 (SOURCE: FILE=9002274.4 FIELD=.58)
; form locator #63a
S ABME("FLD")=.54
D DIQ1
S ABMR(40,50)=ABM(9002274.4,ABMP("BDFN"),.58,"E")
S ABMR(40,50)=$$FMT^ABMERUTL(ABMR(40,50),18)
Q
;
60 ;Treatment Authorization Code-B, 46-63 (SOURCE: FILE=9002274.4, FIELD=)
; form locator #63b
S ABMR(40,60)=""
S ABMR(40,60)=$$FMT^ABMERUTL(ABMR(40,60),18)
Q
;
70 ;Treatment Authorization Code-C, 64-81 (SOURCE: FILE=9002274.4, FIELD=)
; form locator #63c
S ABMR(40,70)=""
S ABMR(40,70)=$$FMT^ABMERUTL(ABMR(40,70),18)
Q
;
80 ;Occurrence Code 1, 82-83 (SOURCE: FILE=9002274.4051, FIELD=.01)
; form locator #32a
D GET51
S ABMR(40,80)=$P($G(ABM(51,1)),U)
S ABMR(40,80)=$$FMT^ABMERUTL(ABMR(40,80),"2")
Q
;
90 ;Occurrence Date 1, 84-91 (SOURCE: FILE=9002274.4051, FIELD=.02)
; form locator #32a
D GET51
S Y=$P($G(ABM(51,1)),"^",2)
S ABMR(40,90)=$$Y2KD2^ABMDUTL(Y)
S ABMR(40,90)=$$FMT^ABMERUTL(ABMR(40,90),8)
Q
;
100 ;Occurrence Code 2, 92-93 (SOURCE: FILE=9002274.4051 FIELD=.01)
; form locator #33a
D GET51
S ABMR(40,100)=$P($G(ABM(51,2)),U)
S ABMR(40,100)=$$FMT^ABMERUTL(ABMR(40,100),"2")
Q
;
110 ;Occurrence Date 2, 94-101 (SOURCE: FILE=9002274.4051, FIELD=.02)
; form locator #33a
D GET51
S Y=$P($G(ABM(51,2)),"^",2)
S ABMR(40,110)=$$Y2KD2^ABMDUTL(Y)
S ABMR(40,110)=$$FMT^ABMERUTL(ABMR(40,110),8)
Q
;
120 ;Occurrence Code 3, 102-103 (SOURCE: FILE=9002274.4051, FIELD=.01)
; form locator #34a
D GET51
S ABMR(40,120)=$P($G(ABM(51,3)),U)
S ABMR(40,120)=$$FMT^ABMERUTL(ABMR(40,120),"2")
Q
;
130 ;Occurrence Date 3, 104-111 (SOURCE: FILE=9002274.4051, FIELD=.02)
; form locator #34a
D GET51
S Y=$P($G(ABM(51,3)),"^",2)
S ABMR(40,130)=$$Y2KD2^ABMDUTL(Y)
S ABMR(40,130)=$$FMT^ABMERUTL(ABMR(40,130),8)
Q
;
140 ;Occurrence Code 4, 112-113 (SOURCE: FILE=9002274.4051, FIELD=.01)
; form locator #35a
D GET51
S ABMR(40,140)=$P($G(ABM(51,4)),U)
S ABMR(40,140)=$$FMT^ABMERUTL(ABMR(40,140),"2")
Q
;
150 ;Occurrence Date 4, 114-121 (SOURCE: FILE=9002274.4051, FIELD=.02)
; form locator #35a
D GET51
S Y=$P($G(ABM(51,4)),"^",2)
S ABMR(40,150)=$$Y2KD2^ABMDUTL(Y)
S ABMR(40,150)=$$FMT^ABMERUTL(ABMR(40,150),8)
Q
;
160 ;Occurrence Code 5, 122-123 (SOURCE: FILE=9002274.4051, FIELD=.01)
; form locator #32b
D GET51 S ABMR(40,160)=$P($G(ABM(51,5)),U)
S ABMR(40,160)=$$FMT^ABMERUTL(ABMR(40,160),"2")
Q
170 ;Occurrence Date 5, 124-131 (SOURCE: FILE=9002274.4051, FIELD=.02)
; form locator #32b
D GET51
S Y=$P($G(ABM(51,5)),"^",2)
S ABMR(40,170)=$$Y2KD2^ABMDUTL(Y)
S ABMR(40,170)=$$FMT^ABMERUTL(ABMR(40,170),8)
Q
;
DIQ1 ;PULL POLICY HOLDER DATA VIA DIQ1
Q:$D(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
N I
S DIQ="ABM("
S DIQ(0)="EI"
S DIC="^ABMDBILL(DUZ(2),"
S DA=ABMP("BDFN")
S DR=".02;.54;.55;.56;.58;.76;.77;.78;.79"
D EN^DIQ1
K DIQ
Q
;
GET51 ;GET OCCURANCE CODES
Q:$D(ABM(51))
N I
S I=0,CNT=0
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,I)) Q:'I D
.S CNT=CNT+1
.S ABM(51,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),51,I,0)
.S $P(ABM(51,CNT),U)=$P($G(^ABMDCODE(+ABM(51,CNT),0)),U)
.S:$L($P(ABM(51,CNT),U))=1 ABM(51,CNT)="0"_ABM(51,CNT)
F I=1:1:10 I '$D(ABM(51,I)) S ABM(51,I)=""
Q
;
GET57 ;GET OCCURRENCE SPAN CODES
Q:$D(ABM(57))
N I
S I=0,CNT=0
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),57,I)) Q:'I D
.S CNT=CNT+1
.S ABM(57,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),57,I,0)
.S $P(ABM(57,CNT),U)=$P($G(^ABMDCODE(+ABM(57,CNT),0)),U)
F I=1,2 I '$D(ABM(57,I)) S ABM(57,I)=""
Q
;
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
;
; INPUT: ABM X = data element
; Y = bill internal entry number
;
; OUTPUT: Y = bill internal entry number
;
S ABMP("BDFN")=ABMY
D SET^ABMERUTL
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(40,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(40,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
Q Y
ABME540A ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 40 (Claim Data) cont'd ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;
+3 ;
LOOP ;LOOP HERE
+1 FOR I=10:10:170
Begin DoDot:1
+2 DO @I
+3 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),40,I))
DO @(^(I))
+4 IF '$GET(ABMP("NOFMT"))
SET ABMREC(40,ABME("S#"))=$GET(ABMREC(40,ABME("S#")))_ABMR(40,I)
End DoDot:1
+5 QUIT
+6 ;
10 ;Record type, 1-2
+1 SET ABMR(40,10)=40
+2 QUIT
+3 ;
20 ;Sequence, 3-4
+1 SET ABMR(40,20)=ABME("S#")
+2 SET ABMR(40,20)=$$FMT^ABMERUTL(ABMR(40,20),"2RN")
+3 QUIT
+4 ;
30 ;Patient Control Number, 5-24 (SOURCE: FILE=9000001.41,FIELD=.02)
+1 SET ABMR(40,30)=$$EX^ABMER20(30,ABMP("BDFN"))
+2 SET ABMR(40,30)=$$FMT^ABMERUTL(ABMR(40,30),20)
+3 QUIT
+4 ;
40 ;Type of Bill, 25-27 (SOURCE: FILE=9002274.4 FIELD=.02)
+1 SET ABME("FLD")=.02
+2 DO DIQ1
+3 SET ABMR(40,40)=ABM(9002274.4,ABMP("BDFN"),.02,"E")
+4 SET ABMR(40,40)=$$FMT^ABMERUTL(ABMR(40,40),3)
+5 QUIT
+6 ;
50 ;Treatment Authorization Code-A, 28-45 (SOURCE: FILE=9002274.4 FIELD=.58)
+1 ; form locator #63a
+2 SET ABME("FLD")=.54
+3 DO DIQ1
+4 SET ABMR(40,50)=ABM(9002274.4,ABMP("BDFN"),.58,"E")
+5 SET ABMR(40,50)=$$FMT^ABMERUTL(ABMR(40,50),18)
+6 QUIT
+7 ;
60 ;Treatment Authorization Code-B, 46-63 (SOURCE: FILE=9002274.4, FIELD=)
+1 ; form locator #63b
+2 SET ABMR(40,60)=""
+3 SET ABMR(40,60)=$$FMT^ABMERUTL(ABMR(40,60),18)
+4 QUIT
+5 ;
70 ;Treatment Authorization Code-C, 64-81 (SOURCE: FILE=9002274.4, FIELD=)
+1 ; form locator #63c
+2 SET ABMR(40,70)=""
+3 SET ABMR(40,70)=$$FMT^ABMERUTL(ABMR(40,70),18)
+4 QUIT
+5 ;
80 ;Occurrence Code 1, 82-83 (SOURCE: FILE=9002274.4051, FIELD=.01)
+1 ; form locator #32a
+2 DO GET51
+3 SET ABMR(40,80)=$PIECE($GET(ABM(51,1)),U)
+4 SET ABMR(40,80)=$$FMT^ABMERUTL(ABMR(40,80),"2")
+5 QUIT
+6 ;
90 ;Occurrence Date 1, 84-91 (SOURCE: FILE=9002274.4051, FIELD=.02)
+1 ; form locator #32a
+2 DO GET51
+3 SET Y=$PIECE($GET(ABM(51,1)),"^",2)
+4 SET ABMR(40,90)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(40,90)=$$FMT^ABMERUTL(ABMR(40,90),8)
+6 QUIT
+7 ;
100 ;Occurrence Code 2, 92-93 (SOURCE: FILE=9002274.4051 FIELD=.01)
+1 ; form locator #33a
+2 DO GET51
+3 SET ABMR(40,100)=$PIECE($GET(ABM(51,2)),U)
+4 SET ABMR(40,100)=$$FMT^ABMERUTL(ABMR(40,100),"2")
+5 QUIT
+6 ;
110 ;Occurrence Date 2, 94-101 (SOURCE: FILE=9002274.4051, FIELD=.02)
+1 ; form locator #33a
+2 DO GET51
+3 SET Y=$PIECE($GET(ABM(51,2)),"^",2)
+4 SET ABMR(40,110)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(40,110)=$$FMT^ABMERUTL(ABMR(40,110),8)
+6 QUIT
+7 ;
120 ;Occurrence Code 3, 102-103 (SOURCE: FILE=9002274.4051, FIELD=.01)
+1 ; form locator #34a
+2 DO GET51
+3 SET ABMR(40,120)=$PIECE($GET(ABM(51,3)),U)
+4 SET ABMR(40,120)=$$FMT^ABMERUTL(ABMR(40,120),"2")
+5 QUIT
+6 ;
130 ;Occurrence Date 3, 104-111 (SOURCE: FILE=9002274.4051, FIELD=.02)
+1 ; form locator #34a
+2 DO GET51
+3 SET Y=$PIECE($GET(ABM(51,3)),"^",2)
+4 SET ABMR(40,130)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(40,130)=$$FMT^ABMERUTL(ABMR(40,130),8)
+6 QUIT
+7 ;
140 ;Occurrence Code 4, 112-113 (SOURCE: FILE=9002274.4051, FIELD=.01)
+1 ; form locator #35a
+2 DO GET51
+3 SET ABMR(40,140)=$PIECE($GET(ABM(51,4)),U)
+4 SET ABMR(40,140)=$$FMT^ABMERUTL(ABMR(40,140),"2")
+5 QUIT
+6 ;
150 ;Occurrence Date 4, 114-121 (SOURCE: FILE=9002274.4051, FIELD=.02)
+1 ; form locator #35a
+2 DO GET51
+3 SET Y=$PIECE($GET(ABM(51,4)),"^",2)
+4 SET ABMR(40,150)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(40,150)=$$FMT^ABMERUTL(ABMR(40,150),8)
+6 QUIT
+7 ;
160 ;Occurrence Code 5, 122-123 (SOURCE: FILE=9002274.4051, FIELD=.01)
+1 ; form locator #32b
+2 DO GET51
SET ABMR(40,160)=$PIECE($GET(ABM(51,5)),U)
+3 SET ABMR(40,160)=$$FMT^ABMERUTL(ABMR(40,160),"2")
+4 QUIT
170 ;Occurrence Date 5, 124-131 (SOURCE: FILE=9002274.4051, FIELD=.02)
+1 ; form locator #32b
+2 DO GET51
+3 SET Y=$PIECE($GET(ABM(51,5)),"^",2)
+4 SET ABMR(40,170)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(40,170)=$$FMT^ABMERUTL(ABMR(40,170),8)
+6 QUIT
+7 ;
DIQ1 ;PULL POLICY HOLDER DATA VIA DIQ1
+1 IF $DATA(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
QUIT
+2 NEW I
+3 SET DIQ="ABM("
+4 SET DIQ(0)="EI"
+5 SET DIC="^ABMDBILL(DUZ(2),"
+6 SET DA=ABMP("BDFN")
+7 SET DR=".02;.54;.55;.56;.58;.76;.77;.78;.79"
+8 DO EN^DIQ1
+9 KILL DIQ
+10 QUIT
+11 ;
GET51 ;GET OCCURANCE CODES
+1 IF $DATA(ABM(51))
QUIT
+2 NEW I
+3 SET I=0
SET CNT=0
+4 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,I))
IF 'I
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET ABM(51,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),51,I,0)
+7 SET $PIECE(ABM(51,CNT),U)=$PIECE($GET(^ABMDCODE(+ABM(51,CNT),0)),U)
+8 IF $LENGTH($PIECE(ABM(51,CNT),U))=1
SET ABM(51,CNT)="0"_ABM(51,CNT)
End DoDot:1
+9 FOR I=1:1:10
IF '$DATA(ABM(51,I))
SET ABM(51,I)=""
+10 QUIT
+11 ;
GET57 ;GET OCCURRENCE SPAN CODES
+1 IF $DATA(ABM(57))
QUIT
+2 NEW I
+3 SET I=0
SET CNT=0
+4 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),57,I))
IF 'I
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET ABM(57,CNT)=^ABMDBILL(DUZ(2),ABMP("BDFN"),57,I,0)
+7 SET $PIECE(ABM(57,CNT),U)=$PIECE($GET(^ABMDCODE(+ABM(57,CNT),0)),U)
End DoDot:1
+8 FOR I=1,2
IF '$DATA(ABM(57,I))
SET ABM(57,I)=""
+9 QUIT
+10 ;
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
+1 ;
+2 ; INPUT: ABM X = data element
+3 ; Y = bill internal entry number
+4 ;
+5 ; OUTPUT: Y = bill internal entry number
+6 ;
+7 SET ABMP("BDFN")=ABMY
+8 DO SET^ABMERUTL
+9 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+10 DO @ABMX
+11 SET Y=ABMR(40,ABMX)
+12 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+13 KILL ABMR(40,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
+14 QUIT Y
