ABMDVCK2 ; IHS/ASDST/DMJ - PCC Visit Edits ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;08/19/96 4:49 PM
;Split off from ABMDVCK0
;
;IHS/DSD/MRS - 9/13/1999 - NOIS BXX-0999-150023 Patch 3 #14
; Increased default lag time from 5 to 45 days
; IHS/ASDS/LSL - 05/19/00 - V2.4 Patch 1 - NOIS NCA-0500-180018
; Modified to do proper checking of POV and orphan lag time
; for children visits where a parent claim already exists and
; has proper POV.
;
;IHS/ASDS/DMJ - 03/20/01 - V2.4 P5 - NOIS NHA-0201-180052
; Modified to correct "Visit location not found in 3P
; site parameters" error
;
; IHS/ASDS/LSL - 06/27/01 - V2.4 Patch 9 - NOIS HQW-0798-100082
; Modified to expand No Eligibility Found. Routine created as
; ABMDVCK0 became too large
;
; *********************************************************************
;
Q
;
;ABML - eligibility array
INS ; EP ;Go thru insurers in eligibility array
;This involves a lot of repeat checking thru stuffing rtns with little
;or no use of info in ABML.
N COVB
S ABMP("INS")=""
F S ABMP("INS")=$O(ABML(ABMP("PRI"),ABMP("INS"))) Q:'ABMP("INS") D Q:$D(ABMP("NOKILLABILL"))!$D(ABMP("LOCKFAIL"))
.S ABM("INS")=ABMP("INS")
.S COVB=""
.I $P(ABML(ABMP("PRI"),ABMP("INS")),U,3)?1(1"M",1"R") D
..Q:"AS"'[SERVCAT
..S I=""
..S COVB="M"
..S:$$PARTB^ABMDSPLB(ABMP("PDFN"),ABMP("VDT")) COVB=1
.I COVB="M",ABMPRIM?1(1"M",1"R") D Q
..S DIE="^AUPNVSIT("
..S DA=ABMVDFN
..S DR=".04////28"
..D ^DIE
.I ABMPRIM="W",ABMP("PRI")=1 D VC Q ;Workmans comp
.D VC2
;ABML is the eligibility array. It is set up in ^ABMDLCK & ^ABMDLCK2
Q
;
; *********************************************************************
VC ; Only executed for workman's comp
;If only dental is billable and not dental clinic quit
I $P($G(^AUTNINS(ABMP("INS"),2)),U,5)="O",$P(^DIC(40.7,ABMP("CLN"),0),U,2)'=56 Q
;If dental not billable and dental clinic quit
I $P(^DIC(40.7,ABMP("CLN"),0),U,2)=56,$P($G(^AUTNINS(ABMP("INS"),2)),U,5)="U" Q
;If clinic pharmacy and its unbillable quit
I $P(^DIC(40.7,ABMP("CLN"),0),U,2)=39,$P($G(^AUTNINS(ABMP("INS"),2)),U,3)="U" Q
;Quit if status unbillable
S ABM("INS2")=$G(^AUTNINS(ABMP("INS"),2)) Q:$P($G(^(1)),U,7)=4
;Check back billing limit
I $P(ABM("INS2"),U,4)>0 S X1=DT,X2=0-($P(ABM("INS2"),U,4)*30.417) D C^%DTC Q:ABMP("VDT")<X
VC2 ; for all types of insurance
S ABM("PRI")=ABMP("PRI")
D ^ABMDVST
I $D(ABMP("CDFN")) L -^ABMDCLM(DUZ(2),ABMP("CDFN"))
Q
;
; *********************************************************************
ORPHAN(VIS) ;EP
;-Potential orphan - allow claim with missing Provider
N OK,PROV,L,BP,VFILE,V0
S OK=""
F VFILE="^AUPNVLAB","^AUPNVPTH","^AUPNVMIC","^AUPNVBB","^AUPNVCYT","^AUPNVMED","^AUPNVRAD" D Q:OK
.I $D(@VFILE@("AD",VIS)) D
..S L=0
..F S L=$O(@VFILE@("AD",VIS,L)) Q:'L D Q:OK
...S PROV=$P($G(@VFILE@(L,12)),U,2)
...I PROV S OK=1
Q:OK OK
S V0=$S($D(ABMP("V0")):ABMP("V0"),1:^AUPNVSIT(VIS,0))
S BP=$P(V0,U,28)
I BP D
.Q:'$D(^AUPNVPRV("AD",BP))
.S OK=1
Q OK
;
; *********************************************************************
MISSPOV(VIS) ; EP ;Allow claim if POV missing
I $D(^AUPNVIMM("AD",VIS)) Q 1
I $D(^AUPNVSK("AD",VIS)) Q 1
I $D(^AUPNVMED("AD",VIS)) Q 1
I $D(^AUPNVPT("AD",VIS)) Q 1
I $D(^AUPNVCPT("AD",VIS)) Q 1
I $D(^AUPNVDXP("AD",VIS)) Q 1
I $D(^AUPNVRAD("AD",VIS)) Q 1
I $D(^AUPNVLAB("AD",VIS)) Q 1
I $D(^AUPNVPTH("AD",VIS)) Q 1
I $D(^AUPNVMIC("AD",VIS)) Q 1
I $D(^AUPNVBB("AD",VIS)) Q 1
Q 0
;
; *********************************************************************
PCFL(X) ; EP ; file .04 field in VISIT file
S DIE="^AUPNVSIT("
S DA=ABMVDFN
S DR=".04////"_X
D ^DIE
Q
ABMDVCK2 ; IHS/ASDST/DMJ - PCC Visit Edits ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;08/19/96 4:49 PM
+3 ;Split off from ABMDVCK0
+4 ;
+5 ;IHS/DSD/MRS - 9/13/1999 - NOIS BXX-0999-150023 Patch 3 #14
+6 ; Increased default lag time from 5 to 45 days
+7 ; IHS/ASDS/LSL - 05/19/00 - V2.4 Patch 1 - NOIS NCA-0500-180018
+8 ; Modified to do proper checking of POV and orphan lag time
+9 ; for children visits where a parent claim already exists and
+10 ; has proper POV.
+11 ;
+12 ;IHS/ASDS/DMJ - 03/20/01 - V2.4 P5 - NOIS NHA-0201-180052
+13 ; Modified to correct "Visit location not found in 3P
+14 ; site parameters" error
+15 ;
+16 ; IHS/ASDS/LSL - 06/27/01 - V2.4 Patch 9 - NOIS HQW-0798-100082
+17 ; Modified to expand No Eligibility Found. Routine created as
+18 ; ABMDVCK0 became too large
+19 ;
+20 ; *********************************************************************
+21 ;
+22 QUIT
+23 ;
+24 ;ABML - eligibility array
INS ; EP ;Go thru insurers in eligibility array
+1 ;This involves a lot of repeat checking thru stuffing rtns with little
+2 ;or no use of info in ABML.
+3 NEW COVB
+4 SET ABMP("INS")=""
+5 FOR
SET ABMP("INS")=$ORDER(ABML(ABMP("PRI"),ABMP("INS")))
IF 'ABMP("INS")
QUIT
Begin DoDot:1
+6 SET ABM("INS")=ABMP("INS")
+7 SET COVB=""
+8 IF $PIECE(ABML(ABMP("PRI"),ABMP("INS")),U,3)?1(1"M",1"R")
Begin DoDot:2
+9 IF "AS"'[SERVCAT
QUIT
+10 SET I=""
+11 SET COVB="M"
+12 IF $$PARTB^ABMDSPLB(ABMP("PDFN"),ABMP("VDT"))
SET COVB=1
End DoDot:2
+13 IF COVB="M"
IF ABMPRIM?1(1"M",1"R")
Begin DoDot:2
+14 SET DIE="^AUPNVSIT("
+15 SET DA=ABMVDFN
+16 SET DR=".04////28"
+17 DO ^DIE
End DoDot:2
QUIT
+18 ;Workmans comp
IF ABMPRIM="W"
IF ABMP("PRI")=1
DO VC
QUIT
+19 DO VC2
End DoDot:1
IF $DATA(ABMP("NOKILLABILL"))!$DATA(ABMP("LOCKFAIL"))
QUIT
+20 ;ABML is the eligibility array. It is set up in ^ABMDLCK & ^ABMDLCK2
+21 QUIT
+22 ;
+23 ; *********************************************************************
VC ; Only executed for workman's comp
+1 ;If only dental is billable and not dental clinic quit
+2 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U,5)="O"
IF $PIECE(^DIC(40.7,ABMP("CLN"),0),U,2)'=56
QUIT
+3 ;If dental not billable and dental clinic quit
+4 IF $PIECE(^DIC(40.7,ABMP("CLN"),0),U,2)=56
IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U,5)="U"
QUIT
+5 ;If clinic pharmacy and its unbillable quit
+6 IF $PIECE(^DIC(40.7,ABMP("CLN"),0),U,2)=39
IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U,3)="U"
QUIT
+7 ;Quit if status unbillable
+8 SET ABM("INS2")=$GET(^AUTNINS(ABMP("INS"),2))
IF $PIECE($GET(^(1)),U,7)=4
QUIT
+9 ;Check back billing limit
+10 IF $PIECE(ABM("INS2"),U,4)>0
SET X1=DT
SET X2=0-($PIECE(ABM("INS2"),U,4)*30.417)
DO C^%DTC
IF ABMP("VDT")<X
QUIT
VC2 ; for all types of insurance
+1 SET ABM("PRI")=ABMP("PRI")
+2 DO ^ABMDVST
+3 IF $DATA(ABMP("CDFN"))
LOCK -^ABMDCLM(DUZ(2),ABMP("CDFN"))
+4 QUIT
+5 ;
+6 ; *********************************************************************
ORPHAN(VIS) ;EP
+1 ;-Potential orphan - allow claim with missing Provider
+2 NEW OK,PROV,L,BP,VFILE,V0
+3 SET OK=""
+4 FOR VFILE="^AUPNVLAB","^AUPNVPTH","^AUPNVMIC","^AUPNVBB","^AUPNVCYT","^AUPNVMED","^AUPNVRAD"
Begin DoDot:1
+5 IF $DATA(@VFILE@("AD",VIS))
Begin DoDot:2
+6 SET L=0
+7 FOR
SET L=$ORDER(@VFILE@("AD",VIS,L))
IF 'L
QUIT
Begin DoDot:3
+8 SET PROV=$PIECE($GET(@VFILE@(L,12)),U,2)
+9 IF PROV
SET OK=1
End DoDot:3
IF OK
QUIT
End DoDot:2
End DoDot:1
IF OK
QUIT
+10 IF OK
QUIT OK
+11 SET V0=$SELECT($DATA(ABMP("V0")):ABMP("V0"),1:^AUPNVSIT(VIS,0))
+12 SET BP=$PIECE(V0,U,28)
+13 IF BP
Begin DoDot:1
+14 IF '$DATA(^AUPNVPRV("AD",BP))
QUIT
+15 SET OK=1
End DoDot:1
+16 QUIT OK
+17 ;
+18 ; *********************************************************************
MISSPOV(VIS) ; EP ;Allow claim if POV missing
+1 IF $DATA(^AUPNVIMM("AD",VIS))
QUIT 1
+2 IF $DATA(^AUPNVSK("AD",VIS))
QUIT 1
+3 IF $DATA(^AUPNVMED("AD",VIS))
QUIT 1
+4 IF $DATA(^AUPNVPT("AD",VIS))
QUIT 1
+5 IF $DATA(^AUPNVCPT("AD",VIS))
QUIT 1
+6 IF $DATA(^AUPNVDXP("AD",VIS))
QUIT 1
+7 IF $DATA(^AUPNVRAD("AD",VIS))
QUIT 1
+8 IF $DATA(^AUPNVLAB("AD",VIS))
QUIT 1
+9 IF $DATA(^AUPNVPTH("AD",VIS))
QUIT 1
+10 IF $DATA(^AUPNVMIC("AD",VIS))
QUIT 1
+11 IF $DATA(^AUPNVBB("AD",VIS))
QUIT 1
+12 QUIT 0
+13 ;
+14 ; *********************************************************************
PCFL(X) ; EP ; file .04 field in VISIT file
+1 SET DIE="^AUPNVSIT("
+2 SET DA=ABMVDFN
+3 SET DR=".04////"_X
+4 DO ^DIE
+5 QUIT
