ABMDE9X ; IHS/ASDST/DMJ - Page 9 - ERROR CHECKS ;
;;2.6;IHS Third Party Billing;**1,6**;NOV 12, 2009
;
; 12/19/03 V2.5 Patch 5 - 837 modifications
; Add 192 error code for imprecise accident dates
; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added page 9G
; IHS/SD/SDR - abm*2.6*6 - 5010 - added error 237
;
A ;EP - for 9A error checks
S:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,4) ABMX("ACCHR")=0 S ABMX=0 F S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMX)) Q:'ABMX D A1
S ABME("TITL")="PAGE 9A - OCCURRENCE CODES"
I $D(ABMX("ACCHR")),ABMX("ACCHR")=0 S ABME(155)=""
; Having a date of accident and accident type determine Accident Related
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3)="Y" D
.I +$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2),$E($P(^(8),U,2),6,7)="00" S ABME(192)=""
K ABMX("ACCHR")
G XIT
A1 S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMX,0)
I $D(ABMX("ACCHR")),(+ABMX("X0")>0&(+ABMX("X0")<7)) S ABMX("ACCHR")=1
I $P(ABMX("X0"),U,2)="" S ABME(138)=""
I $D(ABMP("DDT")),$P(ABMX("X0"),U,2)]"",($P(ABMX("X0"),U,2)\1)>ABMP("DDT") S ABME(130)=""
BTYP ;BILL TYPE CONSISTENCY CHECK
S ABMX("CODE")=$P(^ABMDCODE(+ABMX("X0"),0),U) D
.Q:"20,21,22,26,27,28,34,42"'[ABMX("CODE")
.I ABMX("CODE")=20,"11,41"[$E(ABMP("BTYP"),1,2) Q
.I ABMX("CODE")=21,"18,21"[$E(ABMP("BTYP"),1,2) Q
.I ABMX("CODE")=22,"18,21"[$E(ABMP("BTYP"),1,2) Q
.I ABMX("CODE")=26,"18,21"[$E(ABMP("BTYP"),1,2) Q
.I ABMX("CODE")=27,"32,33"[$E(ABMP("BTYP"),1,2) Q
.I ABMX("CODE")=28,"74,75"[$E(ABMP("BTYP"),1,2) Q
.I ABMX("CODE")=34,$E(ABMP("BTYP"),1,2)=51 Q
.I ABMX("CODE")=42,"811,814,821,824"[ABMP("BTYP") Q
.S ABME(177)=""
Q
;
B ;EP - for 9B error checks
S ABMX=0 F S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),57,ABMX)) Q:'ABMX D B1
S ABME("TITL")="PAGE 9B - OCCURRENCE SPAN CODES"
G XIT
B1 S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),57,ABMX,0)
I $P(ABMX("X0"),U,2)="" S ABME(139)=""
I $P(ABMX("X0"),U,3)="" S ABME(139)=""
I $D(ABMP("DDT")),$P(ABMX("X0"),U,2)]"",($P(ABMX("X0"),U,2)\1)>ABMP("DDT") S ABME(130)=""
I $D(ABMP("DDT")),$P(ABMX("X0"),U,3)]"",($P(ABMX("X0"),U,3)\1)>ABMP("DDT") S ABME(130)=""
I $P(ABMX("X0"),U,2)>$P(ABMX("X0"),U,3) S ABME(140)=""
Q
;
C ;EP - for 9C error checks
I ABMP("BTYP")=111,$P($G(^AUTNINS(+ABMP("INS"),2)),U)="R" D
.K ABMX("OK")
.S ABMX=0 F S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,ABMX)) Q:'ABMX D
..Q:$G(ABMX("OK"))
..S ABMX("CODE")=$P($G(^ABMDCODE(+ABMX,0)),U)
..Q:$E(ABMX("CODE"),1)'="C"
..S ABMX("OK")=1
.I '$G(ABMX("OK")) S ABME(178)=""
S ABME("TITL")="PAGE 9C - CONDITION CODES"
G XIT
;
D ;EP - for 9D error checks
S ABMX=0 F S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),55,ABMX)) Q:'ABMX D D1
S ABME("TITL")="PAGE 9D - VALUE CODES"
G XIT
D1 S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),55,ABMX,0)
I $P(ABMX("X0"),U,2)="" S ABME(141)=""
Q
;
E ;EP - for 9E error checks
;start new code abm*2.6*6 5010
I $G(ABMP("EXP"))=32 D
.S ABMX=0
.F S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABMX)) Q:'ABMX D
..S ABMCODE=$P($G(^ABMDCODE(ABMX,0)),U)
..I "^02^03^05^09^"'[("^"_ABMCODE_"^") S ABME(237)=""
;end new code 5010
Q
;
F ;EP - for 9F error checks
Q
;start new code abm*2.6*1 HEAT6439
G ;EP - for 9G error checks
Q
;end new code HEAT6439
;
XIT K ABMX
Q
ABMDE9X ; IHS/ASDST/DMJ - Page 9 - ERROR CHECKS ;
+1 ;;2.6;IHS Third Party Billing;**1,6**;NOV 12, 2009
+2 ;
+3 ; 12/19/03 V2.5 Patch 5 - 837 modifications
+4 ; Add 192 error code for imprecise accident dates
+5 ; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added page 9G
+6 ; IHS/SD/SDR - abm*2.6*6 - 5010 - added error 237
+7 ;
A ;EP - for 9A error checks
+1 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,4)
SET ABMX("ACCHR")=0
SET ABMX=0
FOR
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMX))
IF 'ABMX
QUIT
DO A1
+2 SET ABME("TITL")="PAGE 9A - OCCURRENCE CODES"
+3 IF $DATA(ABMX("ACCHR"))
IF ABMX("ACCHR")=0
SET ABME(155)=""
+4 ; Having a date of accident and accident type determine Accident Related
+5 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3)="Y"
Begin DoDot:1
+6 IF +$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)
IF $EXTRACT($PIECE(^(8),U,2),6,7)="00"
SET ABME(192)=""
End DoDot:1
+7 KILL ABMX("ACCHR")
+8 GOTO XIT
A1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMX,0)
+1 IF $DATA(ABMX("ACCHR"))
IF (+ABMX("X0")>0&(+ABMX("X0")<7))
SET ABMX("ACCHR")=1
+2 IF $PIECE(ABMX("X0"),U,2)=""
SET ABME(138)=""
+3 IF $DATA(ABMP("DDT"))
IF $PIECE(ABMX("X0"),U,2)]""
IF ($PIECE(ABMX("X0"),U,2)\1)>ABMP("DDT")
SET ABME(130)=""
BTYP ;BILL TYPE CONSISTENCY CHECK
+1 SET ABMX("CODE")=$PIECE(^ABMDCODE(+ABMX("X0"),0),U)
Begin DoDot:1
+2 IF "20,21,22,26,27,28,34,42"'[ABMX("CODE")
QUIT
+3 IF ABMX("CODE")=20
IF "11,41"[$EXTRACT(ABMP("BTYP"),1,2)
QUIT
+4 IF ABMX("CODE")=21
IF "18,21"[$EXTRACT(ABMP("BTYP"),1,2)
QUIT
+5 IF ABMX("CODE")=22
IF "18,21"[$EXTRACT(ABMP("BTYP"),1,2)
QUIT
+6 IF ABMX("CODE")=26
IF "18,21"[$EXTRACT(ABMP("BTYP"),1,2)
QUIT
+7 IF ABMX("CODE")=27
IF "32,33"[$EXTRACT(ABMP("BTYP"),1,2)
QUIT
+8 IF ABMX("CODE")=28
IF "74,75"[$EXTRACT(ABMP("BTYP"),1,2)
QUIT
+9 IF ABMX("CODE")=34
IF $EXTRACT(ABMP("BTYP"),1,2)=51
QUIT
+10 IF ABMX("CODE")=42
IF "811,814,821,824"[ABMP("BTYP")
QUIT
+11 SET ABME(177)=""
End DoDot:1
+12 QUIT
+13 ;
B ;EP - for 9B error checks
+1 SET ABMX=0
FOR
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),57,ABMX))
IF 'ABMX
QUIT
DO B1
+2 SET ABME("TITL")="PAGE 9B - OCCURRENCE SPAN CODES"
+3 GOTO XIT
B1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),57,ABMX,0)
+1 IF $PIECE(ABMX("X0"),U,2)=""
SET ABME(139)=""
+2 IF $PIECE(ABMX("X0"),U,3)=""
SET ABME(139)=""
+3 IF $DATA(ABMP("DDT"))
IF $PIECE(ABMX("X0"),U,2)]""
IF ($PIECE(ABMX("X0"),U,2)\1)>ABMP("DDT")
SET ABME(130)=""
+4 IF $DATA(ABMP("DDT"))
IF $PIECE(ABMX("X0"),U,3)]""
IF ($PIECE(ABMX("X0"),U,3)\1)>ABMP("DDT")
SET ABME(130)=""
+5 IF $PIECE(ABMX("X0"),U,2)>$PIECE(ABMX("X0"),U,3)
SET ABME(140)=""
+6 QUIT
+7 ;
C ;EP - for 9C error checks
+1 IF ABMP("BTYP")=111
IF $PIECE($GET(^AUTNINS(+ABMP("INS"),2)),U)="R"
Begin DoDot:1
+2 KILL ABMX("OK")
+3 SET ABMX=0
FOR
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,ABMX))
IF 'ABMX
QUIT
Begin DoDot:2
+4 IF $GET(ABMX("OK"))
QUIT
+5 SET ABMX("CODE")=$PIECE($GET(^ABMDCODE(+ABMX,0)),U)
+6 IF $EXTRACT(ABMX("CODE"),1)'="C"
QUIT
+7 SET ABMX("OK")=1
End DoDot:2
+8 IF '$GET(ABMX("OK"))
SET ABME(178)=""
End DoDot:1
+9 SET ABME("TITL")="PAGE 9C - CONDITION CODES"
+10 GOTO XIT
+11 ;
D ;EP - for 9D error checks
+1 SET ABMX=0
FOR
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),55,ABMX))
IF 'ABMX
QUIT
DO D1
+2 SET ABME("TITL")="PAGE 9D - VALUE CODES"
+3 GOTO XIT
D1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),55,ABMX,0)
+1 IF $PIECE(ABMX("X0"),U,2)=""
SET ABME(141)=""
+2 QUIT
+3 ;
E ;EP - for 9E error checks
+1 ;start new code abm*2.6*6 5010
+2 IF $GET(ABMP("EXP"))=32
Begin DoDot:1
+3 SET ABMX=0
+4 FOR
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABMX))
IF 'ABMX
QUIT
Begin DoDot:2
+5 SET ABMCODE=$PIECE($GET(^ABMDCODE(ABMX,0)),U)
+6 IF "^02^03^05^09^"'[("^"_ABMCODE_"^")
SET ABME(237)=""
End DoDot:2
End DoDot:1
+7 ;end new code 5010
+8 QUIT
+9 ;
F ;EP - for 9F error checks
+1 QUIT
+2 ;start new code abm*2.6*1 HEAT6439
G ;EP - for 9G error checks
+1 QUIT
+2 ;end new code HEAT6439
+3 ;
XIT KILL ABMX
+1 QUIT
