- 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
