ABMDLCK3 ; IHS/ASDST/DMJ - check visit for elig - CONT'D ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;;Y2K/OK - IHS/ADC/JLG 12-18-97
;Original;TMD;
;
; IHS/ASDS/LSL - 06/27/2001 - V2.4 Patch 9 - NOIS HQW-0798-100082
; Expand No Eligibility Found. Working this call caused
; ABMDLCK1 to be too large. Overflow placed in this routine
;
; *********************************************************************
;
Q
;
PROVSPEC(COVER,PROVDR,BUB) ;EP;For provider class specific CPT, & ICD ranges
;Returns 0 if billable, 1 if not billable
N INRANGE,OUTOFRNG,ISUB,CODE,VGLOB,ICDGLOB,ABME,UNBILLAB,RNGEFLG
F ISUB=1:1:3 D Q:$G(UNBILLAB)=0
.K ABME
.I $O(^AUTTPIC(COVER,15,PROVDR,ISUB,0)) D
..S RNGEFLG=1
..S N=0,ABME=0
..F D Q:CODE=""!($G(UNBILLAB)=0)
...I ISUB=1 D Q ;This sect for CPT codes
....I '$D(AUPNCPT) S Y=$$CPT^AUPNCPT(ABMVDFN)
....S CODE=""
....F S N=$O(AUPNCPT(N)) Q:'N D Q:UNBILLAB=0
.....S CODE=+AUPNCPT(N)
.....D CODECHK
....S CODE="" ;MRS:10/16/98 set variable to quit condit'n when finished
...I ISUB=2 D ;This sect and next for ICD codes
....S VGLOB="^AUPNVPRC"
....S ICDGLOB="^ICD0"
...E D
....S VGLOB="^AUPNVPOV"
....S ICDGLOB="^ICD9"
...I $D(ABME)<10 D
....F S ABME=$O(@VGLOB@("AD",ABMVDFN,ABME)) Q:'ABME D
.....S ABME($P(@ICDGLOB@(+(@VGLOB@(ABME,0)),0),U,1))=""
...S CODE=""
...F S CODE=$O(ABME(CODE)) Q:CODE="" D CODECHK Q:$G(UNBILLAB)=0
I $D(RNGEFLG)=0 D Q UNBILLAB ;Means no ranges defined
.S UNBILLAB=$S(BUB="U":1,1:0)
I '$D(INRANGE) D ;MEANS NO CODES IN VISIT
.I BUB="B" S UNBILLAB=1 Q
.I BUB="U" S UNBILLAB=0
.;If there are no codes found in PCC then we mark the provider class
.;as unbillable if it is only billable for a specific range.
.;it is billable if only unbillable for a specific range.
.;This may not work right if PCC does not contain all of the data.
Q UNBILLAB
;
CODECHK ; Check CPT or ICD code against range
S INRANGE=0,OUTOFRNG=0
S D2=0
F S D2=$O(^AUTTPIC(COVER,15,PROVDR,ISUB,D2)) Q:'D2 D Q:$G(UNBILLAB)=0
.S Y=^AUTTPIC(COVER,15,PROVDR,ISUB,D2,0)
.I '$D(CODE) S UNBILLAB=0 Q
.S CODLO=+Y
.S CODHI=$P(Y,U,2)
.I ISUB>1 D
..S CODLO=$P((@ICDGLOB@(CODLO,0)),U,1)
..S CODHI=$P((@ICDGLOB@(CODHI,0)),U,1)
..I $E(CODLO,1)'?1(1"V",1"E") D
...S CODLO=+CODLO
...S CODHI=+CODHI
.I BUB="B" D Q
..I CODLO']]CODE,CODE']]CODHI S UNBILLAB=0
..;Check to see if CODE is between CODLO & CODHI
..E S UNBILLAB=1 ;But continue looking
.I BUB="U",'INRANGE D
..I (CODLO]]CODE)!(CODE]]CODHI) S OUTOFRNG=1
..E S INRANGE=1,OUTOFRNG=0
Q:BUB="B"
Q:$G(UNBILLAB)=0
I OUTOFRNG S UNBILLAB=0 Q
I INRANGE S UNBILLAB=1 Q
Q
;
;
;At present this code is only executed if ins has cov type entry
PRVX(PRV) ; EP
;Check for default unbillable provider disciplines
;Note that if there is no provider class entry for the provider
;the provider will be considered unbillable.
S ABM("PRV")=$$DOCLASS^ABMDVST2(PRV)
I ABM("PRV")]"",$D(^ABMDPARM(DUZ(2),1,17,ABM("PRV"))) S ABM("PRV")=""
Q ABM("PRV")
ABMDLCK3 ; IHS/ASDST/DMJ - check visit for elig - CONT'D ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;;Y2K/OK - IHS/ADC/JLG 12-18-97
+3 ;Original;TMD;
+4 ;
+5 ; IHS/ASDS/LSL - 06/27/2001 - V2.4 Patch 9 - NOIS HQW-0798-100082
+6 ; Expand No Eligibility Found. Working this call caused
+7 ; ABMDLCK1 to be too large. Overflow placed in this routine
+8 ;
+9 ; *********************************************************************
+10 ;
+11 QUIT
+12 ;
PROVSPEC(COVER,PROVDR,BUB) ;EP;For provider class specific CPT, & ICD ranges
+1 ;Returns 0 if billable, 1 if not billable
+2 NEW INRANGE,OUTOFRNG,ISUB,CODE,VGLOB,ICDGLOB,ABME,UNBILLAB,RNGEFLG
+3 FOR ISUB=1:1:3
Begin DoDot:1
+4 KILL ABME
+5 IF $ORDER(^AUTTPIC(COVER,15,PROVDR,ISUB,0))
Begin DoDot:2
+6 SET RNGEFLG=1
+7 SET N=0
SET ABME=0
+8 FOR
Begin DoDot:3
+9 ;This sect for CPT codes
IF ISUB=1
Begin DoDot:4
+10 IF '$DATA(AUPNCPT)
SET Y=$$CPT^AUPNCPT(ABMVDFN)
+11 SET CODE=""
+12 FOR
SET N=$ORDER(AUPNCPT(N))
IF 'N
QUIT
Begin DoDot:5
+13 SET CODE=+AUPNCPT(N)
+14 DO CODECHK
End DoDot:5
IF UNBILLAB=0
QUIT
+15 ;MRS:10/16/98 set variable to quit condit'n when finished
SET CODE=""
End DoDot:4
QUIT
+16 ;This sect and next for ICD codes
IF ISUB=2
Begin DoDot:4
+17 SET VGLOB="^AUPNVPRC"
+18 SET ICDGLOB="^ICD0"
End DoDot:4
+19 IF '$TEST
Begin DoDot:4
+20 SET VGLOB="^AUPNVPOV"
+21 SET ICDGLOB="^ICD9"
End DoDot:4
+22 IF $DATA(ABME)<10
Begin DoDot:4
+23 FOR
SET ABME=$ORDER(@VGLOB@("AD",ABMVDFN,ABME))
IF 'ABME
QUIT
Begin DoDot:5
+24 SET ABME($PIECE(@ICDGLOB@(+(@VGLOB@(ABME,0)),0),U,1))=""
End DoDot:5
End DoDot:4
+25 SET CODE=""
+26 FOR
SET CODE=$ORDER(ABME(CODE))
IF CODE=""
QUIT
DO CODECHK
IF $GET(UNBILLAB)=0
QUIT
End DoDot:3
IF CODE=""!($GET(UNBILLAB)=0)
QUIT
End DoDot:2
End DoDot:1
IF $GET(UNBILLAB)=0
QUIT
+27 ;Means no ranges defined
IF $DATA(RNGEFLG)=0
Begin DoDot:1
+28 SET UNBILLAB=$SELECT(BUB="U":1,1:0)
End DoDot:1
QUIT UNBILLAB
+29 ;MEANS NO CODES IN VISIT
IF '$DATA(INRANGE)
Begin DoDot:1
+30 IF BUB="B"
SET UNBILLAB=1
QUIT
+31 IF BUB="U"
SET UNBILLAB=0
+32 ;If there are no codes found in PCC then we mark the provider class
+33 ;as unbillable if it is only billable for a specific range.
+34 ;it is billable if only unbillable for a specific range.
+35 ;This may not work right if PCC does not contain all of the data.
End DoDot:1
+36 QUIT UNBILLAB
+37 ;
CODECHK ; Check CPT or ICD code against range
+1 SET INRANGE=0
SET OUTOFRNG=0
+2 SET D2=0
+3 FOR
SET D2=$ORDER(^AUTTPIC(COVER,15,PROVDR,ISUB,D2))
IF 'D2
QUIT
Begin DoDot:1
+4 SET Y=^AUTTPIC(COVER,15,PROVDR,ISUB,D2,0)
+5 IF '$DATA(CODE)
SET UNBILLAB=0
QUIT
+6 SET CODLO=+Y
+7 SET CODHI=$PIECE(Y,U,2)
+8 IF ISUB>1
Begin DoDot:2
+9 SET CODLO=$PIECE((@ICDGLOB@(CODLO,0)),U,1)
+10 SET CODHI=$PIECE((@ICDGLOB@(CODHI,0)),U,1)
+11 IF $EXTRACT(CODLO,1)'?1(1"V",1"E")
Begin DoDot:3
+12 SET CODLO=+CODLO
+13 SET CODHI=+CODHI
End DoDot:3
End DoDot:2
+14 IF BUB="B"
Begin DoDot:2
+15 IF CODLO']]CODE
IF CODE']]CODHI
SET UNBILLAB=0
+16 ;Check to see if CODE is between CODLO & CODHI
+17 ;But continue looking
IF '$TEST
SET UNBILLAB=1
End DoDot:2
QUIT
+18 IF BUB="U"
IF 'INRANGE
Begin DoDot:2
+19 IF (CODLO]]CODE)!(CODE]]CODHI)
SET OUTOFRNG=1
+20 IF '$TEST
SET INRANGE=1
SET OUTOFRNG=0
End DoDot:2
End DoDot:1
IF $GET(UNBILLAB)=0
QUIT
+21 IF BUB="B"
QUIT
+22 IF $GET(UNBILLAB)=0
QUIT
+23 IF OUTOFRNG
SET UNBILLAB=0
QUIT
+24 IF INRANGE
SET UNBILLAB=1
QUIT
+25 QUIT
+26 ;
+27 ;
+28 ;At present this code is only executed if ins has cov type entry
PRVX(PRV) ; EP
+1 ;Check for default unbillable provider disciplines
+2 ;Note that if there is no provider class entry for the provider
+3 ;the provider will be considered unbillable.
+4 SET ABM("PRV")=$$DOCLASS^ABMDVST2(PRV)
+5 IF ABM("PRV")]""
IF $DATA(^ABMDPARM(DUZ(2),1,17,ABM("PRV")))
SET ABM("PRV")=""
+6 QUIT ABM("PRV")
