APCDVCH1 ; IHS/CMI/LAB - CONTINUATION OF APCDVCH ; 02 Nov 2015 11:44 AM
;;2.0;IHS PCC SUITE;**11,13**;MAY 14, 2009;Build 9
CHKDXOP ; CHECK DX VS OPERATIONS AND CHECK FOR DUPLICATE POVS
K APCDDUPE,APCDDXP,APCDVCPS S APCDDX=0 F S APCDDX=$O(^AUPNVPOV("AD",APCDVSIT,APCDDX)) Q:APCDDX="" S APCDVCPS(APCDDX)="" D CHKDXOP1
K APCDVPRC,APCDDUPO,APCDOPP S APCDPX=0 F S APCDPX=$O(^AUPNVPRC("AD",APCDVSIT,APCDPX)) Q:APCDPX="" S APCDOPDX=$P(^AUPNVPRC(APCDPX,0),U,5) S:APCDOPDX]"" APCDVPRC(APCDPX)=APCDOPDX_U_$$CODEC^ICDEX(80,APCDOPDX) D CHKDXOP2
I $D(APCDDUPE),'$D(APCDACC) D DUPE
I $D(APCDDUPO),'$D(APCDACC) D DUPEOP
D C567
Q
CHKDXOP1 ;
I $D(APCDDXP($P(^AUPNVPOV(APCDDX,0),U))) S APCDDUPE=1
S APCDDXP($P(^AUPNVPOV(APCDDX,0),U))=""
Q
CHKDXOP2 ;
I APCDOPDX="" W !,"WARNING: Diagnosis missing in V Procedure Entry!!"
I $D(APCDOPP($P(^AUPNVPRC(APCDPX,0),U))) S APCDDUPO=1
S APCDOPP($P(^AUPNVPRC(APCDPX,0),U))=""
K APCDFOUN F S APCDDX=$O(APCDDXP(APCDDX)) Q:APCDDX="" I APCDDX=APCDOPDX S APCDFOUN=1
I '$D(APCDFOUN) W !,$C(7),"WARNING: Operation ",$$CODEC^ICDEX(80.1,$P(^AUPNVPRC(APCDPX,0),U))," Not for Diagnosis in V POV file!",!,"Notify your Supervisor or Correct!",!
Q
DUPE ;
W !,$C(7),"WARNING: Same ICD9 Code used for 2 POV's. Please Review.",!
Q
DUPEOP ;WARNING RE: DUPLICATE OPERATIONS USED;ACCEPT REQUIRED
W !,$C(7),"WARNING: Same ICD OPERATION/PROCEDURE Code used for 2 OP's. Please Review.",!
Q
;
C567 ;
Q ;no longer do edits
;
S APCD1=0 F S APCD1=$O(APCDVPRC(APCD1)) Q:APCD1="" S APCD2=$P(APCDVPRC(APCD1),U,2),APCDOPC=$$CODEC^ICDEX(80.1,$P(^AUPNVPRC(APCD1,0),U)) D
. I $D(^APCDINPT(5,11,"AC",APCD2)),'$D(^APCDINPT(5,12,"AC",APCDOPC)) W !,$C(7),"WARNING: Procedure Code ",APCDOPC," should not be used with DX code ",APCD2,". Please review.",!
. I $D(^APCDINPT(6,11,"AC",APCD2)),'$D(^APCDINPT(6,12,"AC",APCDOPC)) W !,$C(7),"WARNING: Procedure Code ",APCDOPC," should not be used with DX code ",APCD2,". Please review.",!
. I $D(^APCDINPT(7,11,"AC",APCD2)),'$D(^APCDINPT(7,12,"AC",APCDOPC)) W !,$C(7),"WARNING: Procedure Code ",APCDOPC," should not be used with DX code ",APCD2,". Please review.",!
S APCD1=0 F S APCD1=$O(APCDVCPS(APCD1)) Q:APCD1="" S APCDDX=$P(^AUPNVPOV(APCD1,0),U) I $D(^APCDINPT(6,11,"AC",$$CODEC^ICDEX(80,APCDDX))) D C6ERR
Q
C6ERR ;
I '$D(APCDVPRC) W !,$C(7),"WARNING: A Procedure is REQUIRED when ICD DX code ",$$CODEC^ICDEX(80,APCDDX)," is used!",! Q
K APCDFOUN S APCD2=0 F S APCD2=$O(APCDVPRC(APCD2)) Q:APCD2="" S APCDOP=$$CODEC^ICDEX(80.1,$P(^AUPNVPRC(APCD2,0),U)) I $D(^APCDINPT(6,12,"AC",APCDOP)),$P(APCDVPRC(APCD2),U,1)=APCDDX S APCDFOUN=1
I '$D(APCDFOUN) W !,$C(7),"WARNING: If Diagnosis ",$$CODEC^ICDEX(80,APCDDX)," is used a PROCEDURE is REQUIRED!",!
Q
APCDVCH1 ; IHS/CMI/LAB - CONTINUATION OF APCDVCH ; 02 Nov 2015 11:44 AM
+1 ;;2.0;IHS PCC SUITE;**11,13**;MAY 14, 2009;Build 9
CHKDXOP ; CHECK DX VS OPERATIONS AND CHECK FOR DUPLICATE POVS
+1 KILL APCDDUPE,APCDDXP,APCDVCPS
SET APCDDX=0
FOR
SET APCDDX=$ORDER(^AUPNVPOV("AD",APCDVSIT,APCDDX))
IF APCDDX=""
QUIT
SET APCDVCPS(APCDDX)=""
DO CHKDXOP1
+2 KILL APCDVPRC,APCDDUPO,APCDOPP
SET APCDPX=0
FOR
SET APCDPX=$ORDER(^AUPNVPRC("AD",APCDVSIT,APCDPX))
IF APCDPX=""
QUIT
SET APCDOPDX=$PIECE(^AUPNVPRC(APCDPX,0),U,5)
IF APCDOPDX]""
SET APCDVPRC(APCDPX)=APCDOPDX_U_$$CODEC^ICDEX(80,APCDOPDX)
DO CHKDXOP2
+3 IF $DATA(APCDDUPE)
IF '$DATA(APCDACC)
DO DUPE
+4 IF $DATA(APCDDUPO)
IF '$DATA(APCDACC)
DO DUPEOP
+5 DO C567
+6 QUIT
CHKDXOP1 ;
+1 IF $DATA(APCDDXP($PIECE(^AUPNVPOV(APCDDX,0),U)))
SET APCDDUPE=1
+2 SET APCDDXP($PIECE(^AUPNVPOV(APCDDX,0),U))=""
+3 QUIT
CHKDXOP2 ;
+1 IF APCDOPDX=""
WRITE !,"WARNING: Diagnosis missing in V Procedure Entry!!"
+2 IF $DATA(APCDOPP($PIECE(^AUPNVPRC(APCDPX,0),U)))
SET APCDDUPO=1
+3 SET APCDOPP($PIECE(^AUPNVPRC(APCDPX,0),U))=""
+4 KILL APCDFOUN
FOR
SET APCDDX=$ORDER(APCDDXP(APCDDX))
IF APCDDX=""
QUIT
IF APCDDX=APCDOPDX
SET APCDFOUN=1
+5 IF '$DATA(APCDFOUN)
WRITE !,$CHAR(7),"WARNING: Operation ",$$CODEC^ICDEX(80.1,$PIECE(^AUPNVPRC(APCDPX,0),U))," Not for Diagnosis in V POV file!",!,"Notify your Supervisor or Correct!",!
+6 QUIT
DUPE ;
+1 WRITE !,$CHAR(7),"WARNING: Same ICD9 Code used for 2 POV's. Please Review.",!
+2 QUIT
DUPEOP ;WARNING RE: DUPLICATE OPERATIONS USED;ACCEPT REQUIRED
+1 WRITE !,$CHAR(7),"WARNING: Same ICD OPERATION/PROCEDURE Code used for 2 OP's. Please Review.",!
+2 QUIT
+3 ;
C567 ;
+1 ;no longer do edits
QUIT
+2 ;
+3 SET APCD1=0
FOR
SET APCD1=$ORDER(APCDVPRC(APCD1))
IF APCD1=""
QUIT
SET APCD2=$PIECE(APCDVPRC(APCD1),U,2)
SET APCDOPC=$$CODEC^ICDEX(80.1,$PIECE(^AUPNVPRC(APCD1,0),U))
Begin DoDot:1
+4 IF $DATA(^APCDINPT(5,11,"AC",APCD2))
IF '$DATA(^APCDINPT(5,12,"AC",APCDOPC))
WRITE !,$CHAR(7),"WARNING: Procedure Code ",APCDOPC," should not be used with DX code ",APCD2,". Please review.",!
+5 IF $DATA(^APCDINPT(6,11,"AC",APCD2))
IF '$DATA(^APCDINPT(6,12,"AC",APCDOPC))
WRITE !,$CHAR(7),"WARNING: Procedure Code ",APCDOPC," should not be used with DX code ",APCD2,". Please review.",!
+6 IF $DATA(^APCDINPT(7,11,"AC",APCD2))
IF '$DATA(^APCDINPT(7,12,"AC",APCDOPC))
WRITE !,$CHAR(7),"WARNING: Procedure Code ",APCDOPC," should not be used with DX code ",APCD2,". Please review.",!
End DoDot:1
+7 SET APCD1=0
FOR
SET APCD1=$ORDER(APCDVCPS(APCD1))
IF APCD1=""
QUIT
SET APCDDX=$PIECE(^AUPNVPOV(APCD1,0),U)
IF $DATA(^APCDINPT(6,11,"AC",$$CODEC^ICDEX(80,APCDDX)))
DO C6ERR
+8 QUIT
C6ERR ;
+1 IF '$DATA(APCDVPRC)
WRITE !,$CHAR(7),"WARNING: A Procedure is REQUIRED when ICD DX code ",$$CODEC^ICDEX(80,APCDDX)," is used!",!
QUIT
+2 KILL APCDFOUN
SET APCD2=0
FOR
SET APCD2=$ORDER(APCDVPRC(APCD2))
IF APCD2=""
QUIT
SET APCDOP=$$CODEC^ICDEX(80.1,$PIECE(^AUPNVPRC(APCD2,0),U))
IF $DATA(^APCDINPT(6,12,"AC",APCDOP))
IF $PIECE(APCDVPRC(APCD2),U,1)=APCDDX
SET APCDFOUN=1
+3 IF '$DATA(APCDFOUN)
WRITE !,$CHAR(7),"WARNING: If Diagnosis ",$$CODEC^ICDEX(80,APCDDX)," is used a PROCEDURE is REQUIRED!",!
+4 QUIT
