ABMEH63 ; IHS/FCS/DRS - HCFA-1500 EMC RECORD FB1 (Medical Segment) ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/FCS/DRS - ABM*2.4*9 - New routine - V2.4 Patch 9 Part 1c
; In response to Envoy edit checks about line item provider.
; (waiting to hear from them what kind of place of service
; field is triggering the message about this record)
;
; Rendering Provider info - Part 5c
;
; $$TOS - Type of Service - Part 8
;
; Rendering Provider Network ID - Part 19a
; Stub only for now - waiting more info from site
; regarding they insurer-specific requirements.
;
; FB1 line item data:
; Place of Service Name
; Provider info for each of:
; Ordering, Referring, Rendering, Supervising
;
; $P(ABMRV(J,K),U,7) is the line-item provider
; If that's not present, we have ABMAPRV = the bill's attending prov
;
; IHS/SD/SDR - v2.5 p10 - IM20395
; Split out lines bundled by rev code
;
START ;START HERE
K ABMR(63),ABMREC(63)
D LOOP
S ABME("RTYPE")=63 D S90^ABMERUTL
S ABMEF("LINE")=ABMREC(63)
D WRITE^ABMEF19
Q
LOOP ;LOOP HERE
N ABMEH63
D
.N X S X=$P(ABMRV(J,K,L),U,7) S:'X X=ABMAPRV
.I X S ABMEH63("RENDERING")=X
F I=10:10:250 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),63,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(63)=$G(ABMREC(63))_ABMR(63,I)
Q
10 ;1-3 Record type
S ABMR(63,10)="FB1"
Q
20 ;4-5 Sequence
S ABMR(63,20)=ABME("S#")
S ABMR(63,20)=$$FMT^ABMERUTL(ABMR(63,20),"2NR")
Q
30 ;6-22 Patient Control Number
S ABMR(63,30)=ABMP("PCN")
S ABMR(63,30)=$$FMT^ABMERUTL(ABMR(63,30),17)
Q
40 ;23-39 Line Item Control #
S ABMR(63,40)=""
S ABMR(63,40)=$$FMT^ABMERUTL(ABMR(63,40),17)
Q
50 ;40^33^X^PLACE OF SVC NAME
S ABMR(63,50)=""
S ABMR(63,50)=$$FMT^ABMERUTL(ABMR(63,50),33)
Q
60 ;73^20^X^ORDERING PROVIDER LAST NAME
S ABMR(63,60)=""
S ABMR(63,60)=$$FMT^ABMERUTL(ABMR(63,60),20)
Q
70 ;93^12^X^ORDERING PROVIDER FIRST NAME
S ABMR(63,70)=""
S ABMR(63,70)=$$FMT^ABMERUTL(ABMR(63,70),12)
Q
80 ;105^1^X^ORDERING PROVIDER MI
S ABMR(63,80)=""
S ABMR(63,80)=$$FMT^ABMERUTL(ABMR(63,80),1)
Q
90 ;106^15^X^ORDERING PROVIDER UPIN
S ABMR(63,90)=""
S ABMR(63,90)=$$FMT^ABMERUTL(ABMR(63,90),15)
Q
100 ;121^20^X^REFERRING PROVIDER LAST NAME
S ABMR(63,100)=""
S ABMR(63,100)=$$FMT^ABMERUTL(ABMR(63,100),20)
Q
110 ;141^12^X^REFERRING PROVIDER FIRST NAME
S ABMR(63,110)=""
S ABMR(63,110)=$$FMT^ABMERUTL(ABMR(63,110),12)
Q
120 ;153^1^X^REFERRING PROVIDER MI
S ABMR(63,120)=""
S ABMR(63,120)=$$FMT^ABMERUTL(ABMR(63,120),1)
Q
130 ;154^15^X^REFERRING PROVIDER UPIN
S ABMR(63,130)=""
S ABMR(63,130)=$$FMT^ABMERUTL(ABMR(63,130),15)
Q
140 ;169^20^X^RENDERING PROVIDER LAST NAME
I $G(ABMEH63("RENDERING")) S ABMR(63,140)=$$LNM^ABMEEPRV(ABMEH63("RENDERING"))
E S ABMR(63,140)=""
S ABMR(63,140)=$$FMT^ABMERUTL(ABMR(63,140),20)
Q
150 ;189^12^X^RENDERING PROVIDER FIRST NAME
I $G(ABMEH63("RENDERING")) S ABMR(63,150)=$$FNM^ABMEEPRV(ABMEH63("RENDERING"))
E S ABMR(63,150)=""
S ABMR(63,150)=$$FMT^ABMERUTL(ABMR(63,150),12)
Q
160 ;201^1^X^RENDERING PROVIDER MI
I $G(ABMEH63("RENDERING")) S ABMR(63,160)=$$MI^ABMEEPRV(ABMEH63("RENDERING"))
E S ABMR(63,160)=""
S ABMR(63,160)=$$FMT^ABMERUTL(ABMR(63,160),1)
Q
170 ;202^15^X^RENDERING PROVIDER UPIN
I $G(ABMEH63("RENDERING")) S ABMR(63,170)=$$UPIN^ABMEEPRV(ABMEH63("RENDERING"))
E S ABMR(63,170)=""
S ABMR(63,170)=$$FMT^ABMERUTL(ABMR(63,170),15)
Q
180 ;217^20^X^SUPERVISING PROVIDER LAST NAME
S ABMR(63,180)=""
S ABMR(63,180)=$$FMT^ABMERUTL(ABMR(63,180),20)
Q
190 ;237^12^X^SUPERVISING PROVIDER FIRST NAME
S ABMR(63,190)=""
S ABMR(63,190)=$$FMT^ABMERUTL(ABMR(63,190),12)
Q
200 ;249^1^X^SUPERVISING PROVIDER MI
S ABMR(63,200)=""
S ABMR(63,200)=$$FMT^ABMERUTL(ABMR(63,200),1)
Q
210 ;250^15^X^SUPERVISING PROVIDER NPI
S ABMR(63,210)=""
S ABMR(63,210)=$$FMT^ABMERUTL(ABMR(63,210),15)
Q
220 ;265^15^X^SUPERVISING PROVIDER UPIN
S ABMR(63,220)=""
S ABMR(63,220)=$$FMT^ABMERUTL(ABMR(63,220),15)
Q
230 ;280^20^X^FILLER-FB1-280
S ABMR(63,230)=""
S ABMR(63,230)=$$FMT^ABMERUTL(ABMR(63,230),20)
Q
240 ;300^15^X^RENDERING PROVIDER NETWORK ID (ENVOY SPECIAL)
S ABMR(63,240)="" ;
S ABMR(63,240)=$$FMT^ABMERUTL(ABMR(63,240),15)
Q
250 ;315^6^X^FILLER-FB1-315
S ABMR(63,250)=""
S ABMR(63,250)=$$FMT^ABMERUTL(ABMR(63,250),6)
Q
EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
;X=data element, 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(63,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(63,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
Q Y
;
TOSTSTL ; Loop to test all
D TOSTST("")
N X S X=""
F S X=$O(^ICPT("B",X)) Q:X="" D TOSTST(X)
Q
;
TOSTST(CPT,J) ; devel - test $$TOS logic
W "CPT=",CPT
W " " D
. I CPT]"" D
. . N X S X=$O(^ICPT("B",CPT,0)) Q:'X
. . W $$GET1^DIQ(81,X_",","SHORT NAME")
. . W " ",$$GET1^DIQ(81,X_",","CPT CATEGORY")
. W " -> TOS="
. S:'$D(J) J=21
N K,ABMRV S K=1,ABMRV(J,K,L)=U_CPT
W $$TOS,! Q
;
TOS() ;EP - type of service (where x=multiple from 3P Bill File)
; Called from ABMEH61 and put here because we have $S well <10000
; Modified from TOS^ABMERUTL - some added precision
; We have J, K, and ABMRV(J,K)
N CPT,TOS S CPT=$P(ABMRV(J,K,L),U,2)
I CPT]"" D Q:$D(TOS) TOS
. I CPT="A9220" S TOS=10 Q ; Blood
. S CPTD0=$O(^ICPT("B",CPT,0)) Q:'CPTD0
. N X S X=$G(^ICPT(CPTD0,0)) Q:X=""
. I X["RADIATION THERAPY" S TOS="06" Q ; Radiation Therapy
. I X["CONSULTATION" S TOS="03" Q ; Consultation
. I X["OPINION" D Q:$D(TOS)
. . I X["2ND" S TOS="20" Q ; Second Surgical Opinion
. . I X["3RD" S TOS="21" Q ; Third Surgical Opinion
. I X["DIAGNOSTIC RADIOLOGY" S TOS="04" Q
. N CAT S CAT=$P(X,U,3) Q:'CAT
. S X=$G(^DIC(81.1,CAT,0)) Q:X=""
. I $P(X,U,2)'="m" D Q:X="" ; replace X w/corr "major" node
. . N MAJ S MAJ=$P(X,U,3) I MAJ="" S X="" Q
. . S X=$G(^DIC(81.1,MAJ,0))
. I X["MEDICINE" S TOS="01" Q
. I X["SURGERY" S TOS="02" Q
. I X["RADIOLOGY" S TOS="04" Q
. I X["LABORATORY" S TOS="05" Q
. I X["ANESTHESIA" S TOS="07" Q
; and if we didn't find it, set it based on J subscript
Q:J=21 "02"
Q:J=35 "04"
Q:J=37 "05"
Q:J=39 "07"
Q:J=23 99
Q "01"
ABMEH63 ; IHS/FCS/DRS - HCFA-1500 EMC RECORD FB1 (Medical Segment) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/FCS/DRS - ABM*2.4*9 - New routine - V2.4 Patch 9 Part 1c
+4 ; In response to Envoy edit checks about line item provider.
+5 ; (waiting to hear from them what kind of place of service
+6 ; field is triggering the message about this record)
+7 ;
+8 ; Rendering Provider info - Part 5c
+9 ;
+10 ; $$TOS - Type of Service - Part 8
+11 ;
+12 ; Rendering Provider Network ID - Part 19a
+13 ; Stub only for now - waiting more info from site
+14 ; regarding they insurer-specific requirements.
+15 ;
+16 ; FB1 line item data:
+17 ; Place of Service Name
+18 ; Provider info for each of:
+19 ; Ordering, Referring, Rendering, Supervising
+20 ;
+21 ; $P(ABMRV(J,K),U,7) is the line-item provider
+22 ; If that's not present, we have ABMAPRV = the bill's attending prov
+23 ;
+24 ; IHS/SD/SDR - v2.5 p10 - IM20395
+25 ; Split out lines bundled by rev code
+26 ;
START ;START HERE
+1 KILL ABMR(63),ABMREC(63)
+2 DO LOOP
+3 SET ABME("RTYPE")=63
DO S90^ABMERUTL
+4 SET ABMEF("LINE")=ABMREC(63)
+5 DO WRITE^ABMEF19
+6 QUIT
LOOP ;LOOP HERE
+1 NEW ABMEH63
+2 Begin DoDot:1
+3 NEW X
SET X=$PIECE(ABMRV(J,K,L),U,7)
IF 'X
SET X=ABMAPRV
+4 IF X
SET ABMEH63("RENDERING")=X
End DoDot:1
+5 FOR I=10:10:250
Begin DoDot:1
+6 DO @I
+7 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),63,I))
DO @(^(I))
+8 IF '$GET(ABMP("NOFMT"))
SET ABMREC(63)=$GET(ABMREC(63))_ABMR(63,I)
End DoDot:1
+9 QUIT
10 ;1-3 Record type
+1 SET ABMR(63,10)="FB1"
+2 QUIT
20 ;4-5 Sequence
+1 SET ABMR(63,20)=ABME("S#")
+2 SET ABMR(63,20)=$$FMT^ABMERUTL(ABMR(63,20),"2NR")
+3 QUIT
30 ;6-22 Patient Control Number
+1 SET ABMR(63,30)=ABMP("PCN")
+2 SET ABMR(63,30)=$$FMT^ABMERUTL(ABMR(63,30),17)
+3 QUIT
40 ;23-39 Line Item Control #
+1 SET ABMR(63,40)=""
+2 SET ABMR(63,40)=$$FMT^ABMERUTL(ABMR(63,40),17)
+3 QUIT
50 ;40^33^X^PLACE OF SVC NAME
+1 SET ABMR(63,50)=""
+2 SET ABMR(63,50)=$$FMT^ABMERUTL(ABMR(63,50),33)
+3 QUIT
60 ;73^20^X^ORDERING PROVIDER LAST NAME
+1 SET ABMR(63,60)=""
+2 SET ABMR(63,60)=$$FMT^ABMERUTL(ABMR(63,60),20)
+3 QUIT
70 ;93^12^X^ORDERING PROVIDER FIRST NAME
+1 SET ABMR(63,70)=""
+2 SET ABMR(63,70)=$$FMT^ABMERUTL(ABMR(63,70),12)
+3 QUIT
80 ;105^1^X^ORDERING PROVIDER MI
+1 SET ABMR(63,80)=""
+2 SET ABMR(63,80)=$$FMT^ABMERUTL(ABMR(63,80),1)
+3 QUIT
90 ;106^15^X^ORDERING PROVIDER UPIN
+1 SET ABMR(63,90)=""
+2 SET ABMR(63,90)=$$FMT^ABMERUTL(ABMR(63,90),15)
+3 QUIT
100 ;121^20^X^REFERRING PROVIDER LAST NAME
+1 SET ABMR(63,100)=""
+2 SET ABMR(63,100)=$$FMT^ABMERUTL(ABMR(63,100),20)
+3 QUIT
110 ;141^12^X^REFERRING PROVIDER FIRST NAME
+1 SET ABMR(63,110)=""
+2 SET ABMR(63,110)=$$FMT^ABMERUTL(ABMR(63,110),12)
+3 QUIT
120 ;153^1^X^REFERRING PROVIDER MI
+1 SET ABMR(63,120)=""
+2 SET ABMR(63,120)=$$FMT^ABMERUTL(ABMR(63,120),1)
+3 QUIT
130 ;154^15^X^REFERRING PROVIDER UPIN
+1 SET ABMR(63,130)=""
+2 SET ABMR(63,130)=$$FMT^ABMERUTL(ABMR(63,130),15)
+3 QUIT
140 ;169^20^X^RENDERING PROVIDER LAST NAME
+1 IF $GET(ABMEH63("RENDERING"))
SET ABMR(63,140)=$$LNM^ABMEEPRV(ABMEH63("RENDERING"))
+2 IF '$TEST
SET ABMR(63,140)=""
+3 SET ABMR(63,140)=$$FMT^ABMERUTL(ABMR(63,140),20)
+4 QUIT
150 ;189^12^X^RENDERING PROVIDER FIRST NAME
+1 IF $GET(ABMEH63("RENDERING"))
SET ABMR(63,150)=$$FNM^ABMEEPRV(ABMEH63("RENDERING"))
+2 IF '$TEST
SET ABMR(63,150)=""
+3 SET ABMR(63,150)=$$FMT^ABMERUTL(ABMR(63,150),12)
+4 QUIT
160 ;201^1^X^RENDERING PROVIDER MI
+1 IF $GET(ABMEH63("RENDERING"))
SET ABMR(63,160)=$$MI^ABMEEPRV(ABMEH63("RENDERING"))
+2 IF '$TEST
SET ABMR(63,160)=""
+3 SET ABMR(63,160)=$$FMT^ABMERUTL(ABMR(63,160),1)
+4 QUIT
170 ;202^15^X^RENDERING PROVIDER UPIN
+1 IF $GET(ABMEH63("RENDERING"))
SET ABMR(63,170)=$$UPIN^ABMEEPRV(ABMEH63("RENDERING"))
+2 IF '$TEST
SET ABMR(63,170)=""
+3 SET ABMR(63,170)=$$FMT^ABMERUTL(ABMR(63,170),15)
+4 QUIT
180 ;217^20^X^SUPERVISING PROVIDER LAST NAME
+1 SET ABMR(63,180)=""
+2 SET ABMR(63,180)=$$FMT^ABMERUTL(ABMR(63,180),20)
+3 QUIT
190 ;237^12^X^SUPERVISING PROVIDER FIRST NAME
+1 SET ABMR(63,190)=""
+2 SET ABMR(63,190)=$$FMT^ABMERUTL(ABMR(63,190),12)
+3 QUIT
200 ;249^1^X^SUPERVISING PROVIDER MI
+1 SET ABMR(63,200)=""
+2 SET ABMR(63,200)=$$FMT^ABMERUTL(ABMR(63,200),1)
+3 QUIT
210 ;250^15^X^SUPERVISING PROVIDER NPI
+1 SET ABMR(63,210)=""
+2 SET ABMR(63,210)=$$FMT^ABMERUTL(ABMR(63,210),15)
+3 QUIT
220 ;265^15^X^SUPERVISING PROVIDER UPIN
+1 SET ABMR(63,220)=""
+2 SET ABMR(63,220)=$$FMT^ABMERUTL(ABMR(63,220),15)
+3 QUIT
230 ;280^20^X^FILLER-FB1-280
+1 SET ABMR(63,230)=""
+2 SET ABMR(63,230)=$$FMT^ABMERUTL(ABMR(63,230),20)
+3 QUIT
240 ;300^15^X^RENDERING PROVIDER NETWORK ID (ENVOY SPECIAL)
+1 ;
SET ABMR(63,240)=""
+2 SET ABMR(63,240)=$$FMT^ABMERUTL(ABMR(63,240),15)
+3 QUIT
250 ;315^6^X^FILLER-FB1-315
+1 SET ABMR(63,250)=""
+2 SET ABMR(63,250)=$$FMT^ABMERUTL(ABMR(63,250),6)
+3 QUIT
EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE
+1 ;X=data element, Y=bill internal entry number
+2 SET ABMP("BDFN")=ABMY
DO SET^ABMERUTL
+3 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+4 DO @ABMX
+5 SET Y=ABMR(63,ABMX)
+6 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+7 KILL ABMR(63,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
+8 QUIT Y
+9 ;
TOSTSTL ; Loop to test all
+1 DO TOSTST("")
+2 NEW X
SET X=""
+3 FOR
SET X=$ORDER(^ICPT("B",X))
IF X=""
QUIT
DO TOSTST(X)
+4 QUIT
+5 ;
TOSTST(CPT,J) ; devel - test $$TOS logic
+1 WRITE "CPT=",CPT
+2 WRITE " "
Begin DoDot:1
+3 IF CPT]""
Begin DoDot:2
+4 NEW X
SET X=$ORDER(^ICPT("B",CPT,0))
IF 'X
QUIT
+5 WRITE $$GET1^DIQ(81,X_",","SHORT NAME")
+6 WRITE " ",$$GET1^DIQ(81,X_",","CPT CATEGORY")
End DoDot:2
+7 WRITE " -> TOS="
+8 IF '$DATA(J)
SET J=21
End DoDot:1
+9 NEW K,ABMRV
SET K=1
SET ABMRV(J,K,L)=U_CPT
+10 WRITE $$TOS,!
QUIT
+11 ;
TOS() ;EP - type of service (where x=multiple from 3P Bill File)
+1 ; Called from ABMEH61 and put here because we have $S well <10000
+2 ; Modified from TOS^ABMERUTL - some added precision
+3 ; We have J, K, and ABMRV(J,K)
+4 NEW CPT,TOS
SET CPT=$PIECE(ABMRV(J,K,L),U,2)
+5 IF CPT]""
Begin DoDot:1
+6 ; Blood
IF CPT="A9220"
SET TOS=10
QUIT
+7 SET CPTD0=$ORDER(^ICPT("B",CPT,0))
IF 'CPTD0
QUIT
+8 NEW X
SET X=$GET(^ICPT(CPTD0,0))
IF X=""
QUIT
+9 ; Radiation Therapy
IF X["RADIATION THERAPY"
SET TOS="06"
QUIT
+10 ; Consultation
IF X["CONSULTATION"
SET TOS="03"
QUIT
+11 IF X["OPINION"
Begin DoDot:2
+12 ; Second Surgical Opinion
IF X["2ND"
SET TOS="20"
QUIT
+13 ; Third Surgical Opinion
IF X["3RD"
SET TOS="21"
QUIT
End DoDot:2
IF $DATA(TOS)
QUIT
+14 IF X["DIAGNOSTIC RADIOLOGY"
SET TOS="04"
QUIT
+15 NEW CAT
SET CAT=$PIECE(X,U,3)
IF 'CAT
QUIT
+16 SET X=$GET(^DIC(81.1,CAT,0))
IF X=""
QUIT
+17 ; replace X w/corr "major" node
IF $PIECE(X,U,2)'="m"
Begin DoDot:2
+18 NEW MAJ
SET MAJ=$PIECE(X,U,3)
IF MAJ=""
SET X=""
QUIT
+19 SET X=$GET(^DIC(81.1,MAJ,0))
End DoDot:2
IF X=""
QUIT
+20 IF X["MEDICINE"
SET TOS="01"
QUIT
+21 IF X["SURGERY"
SET TOS="02"
QUIT
+22 IF X["RADIOLOGY"
SET TOS="04"
QUIT
+23 IF X["LABORATORY"
SET TOS="05"
QUIT
+24 IF X["ANESTHESIA"
SET TOS="07"
QUIT
End DoDot:1
IF $DATA(TOS)
QUIT TOS
+25 ; and if we didn't find it, set it based on J subscript
+26 IF J=21
QUIT "02"
+27 IF J=35
QUIT "04"
+28 IF J=37
QUIT "05"
+29 IF J=39
QUIT "07"
+30 IF J=23
QUIT 99
+31 QUIT "01"
