ABMDE5X ; IHS/SD/SDR - Edit Page 5 - ERROR CHK ;
;;2.6;IHS Third Party Billing System;**3,8,14**;NOV 12, 2009;Build 238
;
; IHS/SD/SDR - v2.5 p13 - POA changes
; Added check for error 231
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*14 - ICD10 - 002F and 002H - added ICD10/dual coding warnings/errors
;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ is used so output tranform will be executed for SNOMED/Provider Narrative display.
;
A ;EP
S ABME("TITL")="PAGE 5A - DIAGNOSIS"
S ABMX("PRI")="" F ABMX("I")=0:1 S ABMX("PRI")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX("PRI"))) Q:ABMX("PRI")="" S ABMX=$O(^(ABMX("PRI"),"")) D A1
I 'ABMX("I") S ABME(77)=""
;check if Medicare active/pending
S ABMI=0
F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI)) Q:+ABMI=0 D
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U)=2&("IP"[$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U,3)) S ABMMCRA=1
S ABMX("PRI")=""
F S ABMX("PRI")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX("PRI"))) Q:ABMX("PRI")="" S ABMX=$O(^(ABMX("PRI"),"")) D
.S ABMX("X0")=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMX,0))
.I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) D
..;Q:(ABMP("EXP")'=28)&(ABMP("EXP")'=21) ;UB04 and 837I only ;abm*2.6*8 5010
..Q:(ABMP("EXP")'=28)&(ABMP("EXP")'=21)&(ABMP("EXP")'=31) ;UB04 and 837I only ;abm*2.6*8 5010
..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),6)),U,3)<3071001 ;discharge date prior to 10/1/07; req'd after that
..Q:$P(ABMX("X0"),U,5)'="" ;has POA
..;Q:+$G(ABMMCRA)'=1 ;quit if not Medicare ;abm*2.6*3 HEAT7670
..;Q:$E($P($G(^ICD9(+ABMX("X0"),0)),U),1)="E"!($E($P($G(^ICD9(+ABMX("X0"),0)),U),1)="V") ;abm*2.6*14 ICD10 002F
..I (($E($P($G(^ICD9(+ABMX("X0"),0)),U),1)="E")!($E($P($G(^ICD9(+ABMX("X0"),0)),U),1)="V"))&($P($$DX^ABMCVAPI(+ABMX("X0"),ABMP("VDT")),U,20)=1) Q ;only check ICD9 E- and V-codes ;abm*2.6*14 ICD10 002F
..I $G(ABME(231))="" S ABME(231)=$P(ABMX("X0"),U,2)
..E S ABME(231)=ABME(231)_","_$P(ABMX("X0"),U,2)
;start new code abm*2.6*14 ICD10 002F
S ABMI=0,ABMI9=0,ABMI0=0,ABMICNT=0
F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMI)) Q:'ABMI D
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMI,0)),U,6)=1 S ABMI0=1
.E S ABMI9=1
.S ABMICNT=+$G(ABMICNT)+1
I ABMICNT>0 D
.I ((ABMP("ICD10")>ABMP("VDT"))&(ABMI0>0)&(ABMI9=0)) S ABME(245)="" ;should be ICD9, but is ICD10
.I ((ABMP("ICD10")<ABMP("VDT"))&(ABMI0=0)&(ABMI9>0)) S ABME(246)="" ;should be ICD10, but is ICD9
.I (ABMI0>0)&(ABMI9>0) S ABME(247)="" ;claim is coding with both codes
;end new code ICD10 002F
G XIT
A1 S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMX,0)
I $P(ABMX("X0"),U,3)="" S ABME(162)=""
;E I '$D(^AUTNPOV($P(ABMX("X0"),U,3),0)) S ABME(162)="" ;abm*2.6*14 HEAT161263
E S IENS=ABMX_","_ABMP("CDFN")_"," I $$GET1^DIQ(9002274.3017,IENS,".01","E")="" S ABME(162)="" ;abm*2.6*14 HEAT161263
S ABMX(ABMX)=""
I ABMP("EXP")=31,$P(ABMX("X0"),U,5)=1 S ABME(240)="" ;abm*2.6*8 5010
I ABMX("I")'=0 Q
Q:($P($$DX^ABMCVAPI(+ABMX("X0"),ABMP("VDT")),U,20)=30) ;only do below checks for ICD9 codes ;abm*2.6*14 ICD10 002F
I $E($P($$DX^ABMCVAPI(+ABMX("X0"),ABMP("VDT")),U,2),1)="V" S ABME(154)="" ;CSV-c
I $E($P($$DX^ABMCVAPI(+ABMX("X0"),ABMP("VDT")),U,2),1)="E" S ABME(158)="" ;CSV-c
Q
;
;
B ;EP - Entry Point for checking ICD procedure errors
;start new code abm*2.6*14 ICD10 002H
S ABMI=0,ABMI9=0,ABMI0=0,ABMICNT=0
F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMI)) Q:'ABMI D
.I $P($$ICDOP^ABMCVAPI($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMI,0)),U),ABMP("VDT")),U,2)="ZZZ999" S ABME(248)="" ;uncoded PX
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMI,0)),U,6)=1 S ABMI0=1
.E S ABMI9=1
.S ABMICNT=+$G(ABMICNT)+1
I ABMICNT>0 D
.I ((ABMP("ICD10")>ABMP("VDT"))&(ABMI0>0)&(ABMI9=0)) S ABME(245)="" ;should be ICD9, but is ICD10
.I ((ABMP("ICD10")<ABMP("VDT"))&(ABMI0=0)&(ABMI9>0)) S ABME(246)="" ;should be ICD10, but is ICD9
.I (ABMI0>0)&(ABMI9>0) S ABME(247)="" ;claim is coding with both codes
;end new code ICD10 002H
I $D(ABMP("PX")),ABMP("PX")'="I" Q
S ABME("TITL")="PAGE 5B - ICD PROCEDURES"
S ABMX=0 F S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMX)) Q:'ABMX D B1
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O")),'$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0)) S ABME(3)=""
G XIT
B1 S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMX,0)
I ABMP("INS")]"",$D(^AUTNINS(ABMP("INS"),43,ABMX)) S ABME(157)=""
I $P(ABMX("X0"),U,3)="" S ABME(125)=""
I $P(ABMX("X0"),U,4)="" S ABME(124)=""
E I '$D(^AUTNPOV($P(ABMX("X0"),U,4),0)) S ABME(124)=""
I $P(ABMX("X0"),U,3)]"",$P(ABMX("X0"),U,3)<ABMP("VDT") S ABME(127)=""
I $G(ABMP("DDT")),$P(ABMX("X0"),U,3)]"",$P(ABMX("X0"),U,3)>ABMP("DDT") S ABME(130)=""
Q
;
XIT K ABMX
Q
ABMDE5X ; IHS/SD/SDR - Edit Page 5 - ERROR CHK ;
+1 ;;2.6;IHS Third Party Billing System;**3,8,14**;NOV 12, 2009;Build 238
+2 ;
+3 ; IHS/SD/SDR - v2.5 p13 - POA changes
+4 ; Added check for error 231
+5 ; IHS/SD/SDR - v2.6 CSV
+6 ;IHS/SD/SDR - 2.6*14 - ICD10 - 002F and 002H - added ICD10/dual coding warnings/errors
+7 ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ is used so output tranform will be executed for SNOMED/Provider Narrative display.
+8 ;
A ;EP
+1 SET ABME("TITL")="PAGE 5A - DIAGNOSIS"
+2 SET ABMX("PRI")=""
FOR ABMX("I")=0:1
SET ABMX("PRI")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX("PRI")))
IF ABMX("PRI")=""
QUIT
SET ABMX=$ORDER(^(ABMX("PRI"),""))
DO A1
+3 IF 'ABMX("I")
SET ABME(77)=""
+4 ;check if Medicare active/pending
+5 SET ABMI=0
+6 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U)=2&("IP"[$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U,3))
SET ABMMCRA=1
End DoDot:1
+8 SET ABMX("PRI")=""
+9 FOR
SET ABMX("PRI")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX("PRI")))
IF ABMX("PRI")=""
QUIT
SET ABMX=$ORDER(^(ABMX("PRI"),""))
Begin DoDot:1
+10 SET ABMX("X0")=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMX,0))
+11 IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($EXTRACT(ABMP("BTYP"),1,2)=11)!($EXTRACT(ABMP("BTYP"),1,2)="12"))
Begin DoDot:2
+12 ;Q:(ABMP("EXP")'=28)&(ABMP("EXP")'=21) ;UB04 and 837I only ;abm*2.6*8 5010
+13 ;UB04 and 837I only ;abm*2.6*8 5010
IF (ABMP("EXP")'=28)&(ABMP("EXP")'=21)&(ABMP("EXP")'=31)
QUIT
+14 ;discharge date prior to 10/1/07; req'd after that
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),6)),U,3)<3071001
QUIT
+15 ;has POA
IF $PIECE(ABMX("X0"),U,5)'=""
QUIT
+16 ;Q:+$G(ABMMCRA)'=1 ;quit if not Medicare ;abm*2.6*3 HEAT7670
+17 ;Q:$E($P($G(^ICD9(+ABMX("X0"),0)),U),1)="E"!($E($P($G(^ICD9(+ABMX("X0"),0)),U),1)="V") ;abm*2.6*14 ICD10 002F
+18 ;only check ICD9 E- and V-codes ;abm*2.6*14 ICD10 002F
IF (($EXTRACT($PIECE($GET(^ICD9(+ABMX("X0"),0)),U),1)="E")!($EXTRACT($PIECE($GET(^ICD9(+ABMX("X0"),0)),U),1)="V"))&($PIECE($$DX^ABMCVAPI(+ABMX("X0"),ABMP("VDT")),U,20)=1)
QUIT
+19 IF $GET(ABME(231))=""
SET ABME(231)=$PIECE(ABMX("X0"),U,2)
+20 IF '$TEST
SET ABME(231)=ABME(231)_","_$PIECE(ABMX("X0"),U,2)
End DoDot:2
End DoDot:1
+21 ;start new code abm*2.6*14 ICD10 002F
+22 SET ABMI=0
SET ABMI9=0
SET ABMI0=0
SET ABMICNT=0
+23 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+24 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMI,0)),U,6)=1
SET ABMI0=1
+25 IF '$TEST
SET ABMI9=1
+26 SET ABMICNT=+$GET(ABMICNT)+1
End DoDot:1
+27 IF ABMICNT>0
Begin DoDot:1
+28 ;should be ICD9, but is ICD10
IF ((ABMP("ICD10")>ABMP("VDT"))&(ABMI0>0)&(ABMI9=0))
SET ABME(245)=""
+29 ;should be ICD10, but is ICD9
IF ((ABMP("ICD10")<ABMP("VDT"))&(ABMI0=0)&(ABMI9>0))
SET ABME(246)=""
+30 ;claim is coding with both codes
IF (ABMI0>0)&(ABMI9>0)
SET ABME(247)=""
End DoDot:1
+31 ;end new code ICD10 002F
+32 GOTO XIT
A1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMX,0)
+1 IF $PIECE(ABMX("X0"),U,3)=""
SET ABME(162)=""
+2 ;E I '$D(^AUTNPOV($P(ABMX("X0"),U,3),0)) S ABME(162)="" ;abm*2.6*14 HEAT161263
+3 ;abm*2.6*14 HEAT161263
IF '$TEST
SET IENS=ABMX_","_ABMP("CDFN")_","
IF $$GET1^DIQ(9002274.3017,IENS,".01","E")=""
SET ABME(162)=""
+4 SET ABMX(ABMX)=""
+5 ;abm*2.6*8 5010
IF ABMP("EXP")=31
IF $PIECE(ABMX("X0"),U,5)=1
SET ABME(240)=""
+6 IF ABMX("I")'=0
QUIT
+7 ;only do below checks for ICD9 codes ;abm*2.6*14 ICD10 002F
IF ($PIECE($$DX^ABMCVAPI(+ABMX("X0"),ABMP("VDT")),U,20)=30)
QUIT
+8 ;CSV-c
IF $EXTRACT($PIECE($$DX^ABMCVAPI(+ABMX("X0"),ABMP("VDT")),U,2),1)="V"
SET ABME(154)=""
+9 ;CSV-c
IF $EXTRACT($PIECE($$DX^ABMCVAPI(+ABMX("X0"),ABMP("VDT")),U,2),1)="E"
SET ABME(158)=""
+10 QUIT
+11 ;
+12 ;
B ;EP - Entry Point for checking ICD procedure errors
+1 ;start new code abm*2.6*14 ICD10 002H
+2 SET ABMI=0
SET ABMI9=0
SET ABMI0=0
SET ABMICNT=0
+3 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+4 ;uncoded PX
IF $PIECE($$ICDOP^ABMCVAPI($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMI,0)),U),ABMP("VDT")),U,2)="ZZZ999"
SET ABME(248)=""
+5 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMI,0)),U,6)=1
SET ABMI0=1
+6 IF '$TEST
SET ABMI9=1
+7 SET ABMICNT=+$GET(ABMICNT)+1
End DoDot:1
+8 IF ABMICNT>0
Begin DoDot:1
+9 ;should be ICD9, but is ICD10
IF ((ABMP("ICD10")>ABMP("VDT"))&(ABMI0>0)&(ABMI9=0))
SET ABME(245)=""
+10 ;should be ICD10, but is ICD9
IF ((ABMP("ICD10")<ABMP("VDT"))&(ABMI0=0)&(ABMI9>0))
SET ABME(246)=""
+11 ;claim is coding with both codes
IF (ABMI0>0)&(ABMI9>0)
SET ABME(247)=""
End DoDot:1
+12 ;end new code ICD10 002H
+13 IF $DATA(ABMP("PX"))
IF ABMP("PX")'="I"
QUIT
+14 SET ABME("TITL")="PAGE 5B - ICD PROCEDURES"
+15 SET ABMX=0
FOR
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMX))
IF 'ABMX
QUIT
DO B1
+16 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O"))
IF '$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0))
SET ABME(3)=""
+17 GOTO XIT
B1 SET ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMX,0)
+1 IF ABMP("INS")]""
IF $DATA(^AUTNINS(ABMP("INS"),43,ABMX))
SET ABME(157)=""
+2 IF $PIECE(ABMX("X0"),U,3)=""
SET ABME(125)=""
+3 IF $PIECE(ABMX("X0"),U,4)=""
SET ABME(124)=""
+4 IF '$TEST
IF '$DATA(^AUTNPOV($PIECE(ABMX("X0"),U,4),0))
SET ABME(124)=""
+5 IF $PIECE(ABMX("X0"),U,3)]""
IF $PIECE(ABMX("X0"),U,3)<ABMP("VDT")
SET ABME(127)=""
+6 IF $GET(ABMP("DDT"))
IF $PIECE(ABMX("X0"),U,3)]""
IF $PIECE(ABMX("X0"),U,3)>ABMP("DDT")
SET ABME(130)=""
+7 QUIT
+8 ;
XIT KILL ABMX
+1 QUIT
