Routine: ABMDVCK2

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

 ; *********************************************************************

 ;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

 ; *********************************************************************

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

 ; *********************************************************************

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

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

ABMDVCK2.m