- 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")
