APCDVCHK ; IHS/CMI/LAB - CHECK VISIT ;
;;2.0;IHS PCC SUITE;**2,8,11,15,17**;MAY 14, 2009;Build 18
;
; APCDVSIT must equal the VISIT DFN to be checked.
; U must exist and be equal to "^".
;
START ;
;D EN1^APCDKMM ;for future use with X Linkage
Q:'$D(^AUPNVSIT(APCDVSIT))
S APCDVREC=^AUPNVSIT(APCDVSIT,0)
Q:"EX"[$P(APCDVREC,U,7)
S APCDVCLC=$P(APCDVREC,U,6)
Q:APCDVCLC=""
S APCDVCLC=$E($P(^AUTTLOC(APCDVCLC,0),U,10),5,6)
I '$D(^AUPNVPOV("AD",APCDVSIT)) W !,"WARNING: No purpose of visit entered for this visit!",!,$C(7)
I '$D(^AUPNVPRV("AD",APCDVSIT)) W !,"WARNING: No provider of service entered for this VISIT!",!,$C(7)
I $P(APCDVREC,U,8)="",$P(APCDVREC,U,7)="A","I6TP"[$P(APCDVREC,U,3),APCDVCLC>0,APCDVCLC<50 W !,"WARNING: No Clinic Type entered for this visit!",!,$C(7) S APCDNOCL=""
I $P(APCDVREC,U,7)="H",$P(APCDVREC,U,3)'="C",'$D(^AUPNVINP("AD",APCDVSIT)) W !,"WARNING: No V Hospitalization record has been created!",$C(7)
I $P(APCDVREC,U,3)="C",'$D(^AUPNVCHS("AD",APCDVSIT)) W !,"WARNING: No V CHS record has been created!",$C(7)
I $P(APCDVREC,U,7)="H",$P(APCDVREC,U,3)'["CV" D ^APCDVCH
S (APCDVC1,APCDVC2)=0 F APCDVCL=0:0 S APCDVC2=$O(^AUPNVPRV("AD",APCDVSIT,APCDVC2)) Q:APCDVC2="" I $P(^AUPNVPRV(APCDVC2,0),U,4)="P" S APCDVC1=APCDVC1+1
I APCDVC1=0 W !,"WARNING: No primary provider entered for this visit!",!,$C(7)
E I APCDVC1>1 W !,"WARNING: Multiple primary providers were entered for this visit!",!,$C(7) S APCDMPQ=0
I $D(^AUPNVPRC("AD",APCDVSIT)),$P(APCDVREC,U,7)'="H" D CHKPRC
I $$CLINIC^APCLV(APCDVSIT,"C")=30 D CHKER ;IHS/CMI/GRL
I "AOSCTRM"[$P(^AUPNVSIT(APCDVSIT,0),U,7),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")>$P(^APCCCTRL(DUZ(2),0),U,12) D CHKEHR
;above added for EHR and auditing of visits, d/e created
CHKH ;
I $P(APCDVREC,U,7)="H",$P(APCDVREC,U,3)'="C" D CHKH1
D CHKCHA
K APCDVC1,APCDVC2,APCDVCL,APCDVCLC,APCDERR,APCD1,APCD2,APCDVCPV,APCDTS,APCDDS,APCDVREC,APCDDX,APCDOPDX,APCDDXP,APCDFOUN,APCDPX
Q
;
CHKPRC ;check outpatient procedures vs. dx for priv. billing
K APCDDXP S APCDDX=0 F S APCDDX=$O(^AUPNVPOV("AD",APCDVSIT,APCDDX)) Q:APCDDX="" S APCDDXP($P(^AUPNVPOV(APCDDX,0),U))=""
K APCDOPDX S APCDPX=0 F S APCDPX=$O(^AUPNVPRC("AD",APCDVSIT,APCDPX)) Q:APCDPX="" S APCDOPDX=$P(^AUPNVPRC(APCDPX,0),U,5) I APCDOPDX]"" D CHKDXOP2
Q
CHKDXOP2 ;
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,1))," Not for Diagnosis in V POV file!",!,"Notify your Supervisor or Correct!",!
Q
;
CHKH1 ;
;NO LONGER NECESSARY WITH THE DATA WAREHOUSE EXPORT, PCC EXPORT NO LONGER USED
Q:'$D(^AUPNVINP("AD",APCDVSIT))
Q:'$D(^AUPNVPRV("AD",APCDVSIT))
Q:'$D(^AUPNVPOV("AD",APCDVSIT))
K DIR,DIRUT,DUOUT,DTOUT,X,Y
S DIR(0)="Y",DIR("A")="Is this Hospitalization visit ready for export to Headquarters (coding complete)",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
W !,"This visit will be exported to the Data Warehouse."
I Y=0 W !,"Don't forget to finalize the coding so this Hospitalization visit ",!,"can be exported.",! Q
;W !,"This Hospitalization Visit will now be considered complete and will be",!,"exported to Headquarters with your next regular PCC export!",!
;W !,"This visit will be exported to the Data Warehouse."
S DIE="^AUPNVINP(",DA=$O(^AUPNVINP("AD",APCDVSIT,"")),DR=".15///@" D ^DIE
Q
CHKEHR2 ;
;if visit is deleted, don't bother with status update
I $P(^AUPNVSIT(APCDVSIT,0),U,11) Q ;visit is deleted.
I "AOSCTRM"[$P(^AUPNVSIT(APCDVSIT,0),U,7),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")>$P(^APCCCTRL(DUZ(2),0),U,12) D CHKEHR
Q
CHKEHR ;
Q:$G(APCDCAF)="IN CAF"
;K DIR,DIRUT,DUOUT,DTOUT,X,Y
;S DIR(0)="Y",DIR("A")="Is coding complete for this visit (is all data entry completed)",DIR("B")=$P($G(^APCDSITE(DUZ(2),0)),U,29) D ^DIR K DIR S:$D(DUOUT) DIRUT=1
;I $D(DIRUT) S APCDYN=0 G N
;S APCDYN=Y
N W !!,"Please update the visit status for this visit.",! D UPDATE Q
CHKCHA ;
Q:'$P($G(^APCDSITE(DUZ(2),0)),U,35)
CHA ;
Q:DUZ("AG")'="I"
Q:"ETC"[$P(APCDVREC,U,7)
Q:"V"[$P(APCDVREC,U,3)
Q:'$D(^AUPNVPRV("AD",APCDVSIT))
Q:'$D(^AUPNVPOV("AD",APCDVSIT))
S APCDRV("CHA")=0
S (APCDRV(1),APCDRV(2))=0
F S APCDRV(2)=$O(^AUPNVPRV("AD",APCDVSIT,APCDRV(2))) Q:APCDRV(2)="" D DISC
;check secondary providers
CHA2 ;
Q:APCDRV("CHA")=0
I '$D(^AUPNVTM("AD",APCDVSIT)) W !!,"WARNING: COMMUNITY HEALTH NURSE RECORD - NO ACTIVITY TIME ENTERED",$C(7)
K APCDRV
Q
DISC ;
D DISC200
Q
DISC200 ;
S APCDRV("AP")=$P(^AUPNVPRV(APCDRV(2),0),U,1),APCDRV("DISC")=""
Q:'$D(^VA(200,APCDRV("AP")))
S APCDRV("CHA DISC")=$$PROVCLSC^XBFUNC1(APCDRV("AP"))
Q:APCDRV("CHA DISC")'=13&(APCDRV("CHA DISC")'=32)
S APCDRV("CHA")=APCDRV("CHA")+1
Q
CHKER ;IHS/CMI/GRL Check for ER visit w/o V ER record
K DIR,DA,X,Y
Q:$D(^AUPNVER("AD",APCDVSIT))
W !!,"WARNING ... Emergency Clinic visit with NO ER record!",$C(7),!
S DIR(0)="Y",DIR("A")="Quit without entering ER Record"
S DIR("A",1)="ER record with a minimum of Disposition and Departure date and time recommended."
S DIR("A",2)=""
S DIR("B")="N"
D ^DIR K DIR
I Y=1 Q
I Y=0 S APCDMPQ=0 Q
Q
;
UPDATE ;
K DIC,DD,D0,DO
S X=$$NOW^XLFDT,DIC="^AUPNVCA(",DIC(0)="L",DIADD=1,DLAYGO=9000010.45,DIC("DR")=".02////"_$P(^AUPNVSIT(APCDVSIT,0),U,5)_";.03////"_APCDVSIT_";.05////"_DUZ_";1216////"_$$NOW^XLFDT D FILE^DICN
I Y=-1 W !!,"updating status failed" H 2 G UPDATEX
K DIC,DD,D0,DIADD,DLAYGO
S (APCDVCA,DA)=+Y
UPD0 ;EP
K DIC,DD,D0,DO
;
UPD1 ;
D ^XBFMK
S DA=APCDVCA,DIE="^AUPNVCA(",DR=".04" D ^DIE K DA,DIE,DR
S APCDCAR=$P(^AUPNVCA(APCDVCA,0),U,4)
I APCDCAR="" W !!,"You must enter a status" G UPD1
S APCDERR=$$ERRORCHK^APCDCAF(APCDVSIT)
I APCDERR]"",APCDCAR="R" W !!,"This visit has the following error: ",APCDERR,!,"You cannot mark a visit as Reviewed/Completed if there is an error." S DA=APCDVCA,DIE="^AUPNVCA(",DR=".04///I" D ^DIE G UPD1
S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=".13////"_DT_";1111////"_APCDCAR D ^DIE K DIE,DA,DR
I APCDCAR="R" D RNU^APCDCAF4 G UPDATEX
R ;
D EN^XBNEW("EN^APCDCAF6(APCDVSIT)","APCDVSIT")
I '$$FINDPEND^APCDCAF6(APCDVSIT),$$VALI^XBDIQ1(9000010,APCDVSIT,1111)'="R",$P(^APCDSITE(DUZ(2),0),U,32) W !!,"A chart Deficiency reason is required." H 3 G R
;
UPDATEX ;
K DIADD,DLAYGO
D ^XBFMK
K APCDCAR,APCDVCA
Q
;
ADDCANT ;
S ^AUPNCANT(APCDVSIT,0)=APCDVSIT_U_$P(^AUPNVSIT(APCDVSIT,0),U,5)
S DA=APCDVSIT,DIK="^AUPNCANT(" D IX1^DIK
Q
APCDVCHK ; IHS/CMI/LAB - CHECK VISIT ;
+1 ;;2.0;IHS PCC SUITE;**2,8,11,15,17**;MAY 14, 2009;Build 18
+2 ;
+3 ; APCDVSIT must equal the VISIT DFN to be checked.
+4 ; U must exist and be equal to "^".
+5 ;
START ;
+1 ;D EN1^APCDKMM ;for future use with X Linkage
+2 IF '$DATA(^AUPNVSIT(APCDVSIT))
QUIT
+3 SET APCDVREC=^AUPNVSIT(APCDVSIT,0)
+4 IF "EX"[$PIECE(APCDVREC,U,7)
QUIT
+5 SET APCDVCLC=$PIECE(APCDVREC,U,6)
+6 IF APCDVCLC=""
QUIT
+7 SET APCDVCLC=$EXTRACT($PIECE(^AUTTLOC(APCDVCLC,0),U,10),5,6)
+8 IF '$DATA(^AUPNVPOV("AD",APCDVSIT))
WRITE !,"WARNING: No purpose of visit entered for this visit!",!,$CHAR(7)
+9 IF '$DATA(^AUPNVPRV("AD",APCDVSIT))
WRITE !,"WARNING: No provider of service entered for this VISIT!",!,$CHAR(7)
+10 IF $PIECE(APCDVREC,U,8)=""
IF $PIECE(APCDVREC,U,7)="A"
IF "I6TP"[$PIECE(APCDVREC,U,3)
IF APCDVCLC>0
IF APCDVCLC<50
WRITE !,"WARNING: No Clinic Type entered for this visit!",!,$CHAR(7)
SET APCDNOCL=""
+11 IF $PIECE(APCDVREC,U,7)="H"
IF $PIECE(APCDVREC,U,3)'="C"
IF '$DATA(^AUPNVINP("AD",APCDVSIT))
WRITE !,"WARNING: No V Hospitalization record has been created!",$CHAR(7)
+12 IF $PIECE(APCDVREC,U,3)="C"
IF '$DATA(^AUPNVCHS("AD",APCDVSIT))
WRITE !,"WARNING: No V CHS record has been created!",$CHAR(7)
+13 IF $PIECE(APCDVREC,U,7)="H"
IF $PIECE(APCDVREC,U,3)'["CV"
DO ^APCDVCH
+14 SET (APCDVC1,APCDVC2)=0
FOR APCDVCL=0:0
SET APCDVC2=$ORDER(^AUPNVPRV("AD",APCDVSIT,APCDVC2))
IF APCDVC2=""
QUIT
IF $PIECE(^AUPNVPRV(APCDVC2,0),U,4)="P"
SET APCDVC1=APCDVC1+1
+15 IF APCDVC1=0
WRITE !,"WARNING: No primary provider entered for this visit!",!,$CHAR(7)
+16 IF '$TEST
IF APCDVC1>1
WRITE !,"WARNING: Multiple primary providers were entered for this visit!",!,$CHAR(7)
SET APCDMPQ=0
+17 IF $DATA(^AUPNVPRC("AD",APCDVSIT))
IF $PIECE(APCDVREC,U,7)'="H"
DO CHKPRC
+18 ;IHS/CMI/GRL
IF $$CLINIC^APCLV(APCDVSIT,"C")=30
DO CHKER
+19 IF "AOSCTRM"[$PIECE(^AUPNVSIT(APCDVSIT,0),U,7)
IF $PIECE(^APCCCTRL(DUZ(2),0),U,12)]""
IF $PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")>$PIECE(^APCCCTRL(DUZ(2),0),U,12)
DO CHKEHR
+20 ;above added for EHR and auditing of visits, d/e created
CHKH ;
+1 IF $PIECE(APCDVREC,U,7)="H"
IF $PIECE(APCDVREC,U,3)'="C"
DO CHKH1
+2 DO CHKCHA
+3 KILL APCDVC1,APCDVC2,APCDVCL,APCDVCLC,APCDERR,APCD1,APCD2,APCDVCPV,APCDTS,APCDDS,APCDVREC,APCDDX,APCDOPDX,APCDDXP,APCDFOUN,APCDPX
+4 QUIT
+5 ;
CHKPRC ;check outpatient procedures vs. dx for priv. billing
+1 KILL APCDDXP
SET APCDDX=0
FOR
SET APCDDX=$ORDER(^AUPNVPOV("AD",APCDVSIT,APCDDX))
IF APCDDX=""
QUIT
SET APCDDXP($PIECE(^AUPNVPOV(APCDDX,0),U))=""
+2 KILL APCDOPDX
SET APCDPX=0
FOR
SET APCDPX=$ORDER(^AUPNVPRC("AD",APCDVSIT,APCDPX))
IF APCDPX=""
QUIT
SET APCDOPDX=$PIECE(^AUPNVPRC(APCDPX,0),U,5)
IF APCDOPDX]""
DO CHKDXOP2
+3 QUIT
CHKDXOP2 ;
+1 KILL APCDFOUN
FOR
SET APCDDX=$ORDER(APCDDXP(APCDDX))
IF APCDDX=""
QUIT
IF APCDDX=APCDOPDX
SET APCDFOUN=1
+2 IF '$DATA(APCDFOUN)
WRITE !,$CHAR(7),"WARNING: Operation ",$$CODEC^ICDEX(80.1,$PIECE(^AUPNVPRC(APCDPX,0),U,1))," Not for Diagnosis in V POV file!",!,"Notify your Supervisor or Correct!",!
+3 QUIT
+4 ;
CHKH1 ;
+1 ;NO LONGER NECESSARY WITH THE DATA WAREHOUSE EXPORT, PCC EXPORT NO LONGER USED
+2 IF '$DATA(^AUPNVINP("AD",APCDVSIT))
QUIT
+3 IF '$DATA(^AUPNVPRV("AD",APCDVSIT))
QUIT
+4 IF '$DATA(^AUPNVPOV("AD",APCDVSIT))
QUIT
+5 KILL DIR,DIRUT,DUOUT,DTOUT,X,Y
+6 SET DIR(0)="Y"
SET DIR("A")="Is this Hospitalization visit ready for export to Headquarters (coding complete)"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+7 IF $DATA(DIRUT)
QUIT
+8 WRITE !,"This visit will be exported to the Data Warehouse."
+9 IF Y=0
WRITE !,"Don't forget to finalize the coding so this Hospitalization visit ",!,"can be exported.",!
QUIT
+10 ;W !,"This Hospitalization Visit will now be considered complete and will be",!,"exported to Headquarters with your next regular PCC export!",!
+11 ;W !,"This visit will be exported to the Data Warehouse."
+12 SET DIE="^AUPNVINP("
SET DA=$ORDER(^AUPNVINP("AD",APCDVSIT,""))
SET DR=".15///@"
DO ^DIE
+13 QUIT
CHKEHR2 ;
+1 ;if visit is deleted, don't bother with status update
+2 ;visit is deleted.
IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,11)
QUIT
+3 IF "AOSCTRM"[$PIECE(^AUPNVSIT(APCDVSIT,0),U,7)
IF $PIECE(^APCCCTRL(DUZ(2),0),U,12)]""
IF $PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")>$PIECE(^APCCCTRL(DUZ(2),0),U,12)
DO CHKEHR
+4 QUIT
CHKEHR ;
+1 IF $GET(APCDCAF)="IN CAF"
QUIT
+2 ;K DIR,DIRUT,DUOUT,DTOUT,X,Y
+3 ;S DIR(0)="Y",DIR("A")="Is coding complete for this visit (is all data entry completed)",DIR("B")=$P($G(^APCDSITE(DUZ(2),0)),U,29) D ^DIR K DIR S:$D(DUOUT) DIRUT=1
+4 ;I $D(DIRUT) S APCDYN=0 G N
+5 ;S APCDYN=Y
N WRITE !!,"Please update the visit status for this visit.",!
DO UPDATE
QUIT
CHKCHA ;
+1 IF '$PIECE($GET(^APCDSITE(DUZ(2),0)),U,35)
QUIT
CHA ;
+1 IF DUZ("AG")'="I"
QUIT
+2 IF "ETC"[$PIECE(APCDVREC,U,7)
QUIT
+3 IF "V"[$PIECE(APCDVREC,U,3)
QUIT
+4 IF '$DATA(^AUPNVPRV("AD",APCDVSIT))
QUIT
+5 IF '$DATA(^AUPNVPOV("AD",APCDVSIT))
QUIT
+6 SET APCDRV("CHA")=0
+7 SET (APCDRV(1),APCDRV(2))=0
+8 FOR
SET APCDRV(2)=$ORDER(^AUPNVPRV("AD",APCDVSIT,APCDRV(2)))
IF APCDRV(2)=""
QUIT
DO DISC
+9 ;check secondary providers
CHA2 ;
+1 IF APCDRV("CHA")=0
QUIT
+2 IF '$DATA(^AUPNVTM("AD",APCDVSIT))
WRITE !!,"WARNING: COMMUNITY HEALTH NURSE RECORD - NO ACTIVITY TIME ENTERED",$CHAR(7)
+3 KILL APCDRV
+4 QUIT
DISC ;
+1 DO DISC200
+2 QUIT
DISC200 ;
+1 SET APCDRV("AP")=$PIECE(^AUPNVPRV(APCDRV(2),0),U,1)
SET APCDRV("DISC")=""
+2 IF '$DATA(^VA(200,APCDRV("AP")))
QUIT
+3 SET APCDRV("CHA DISC")=$$PROVCLSC^XBFUNC1(APCDRV("AP"))
+4 IF APCDRV("CHA DISC")'=13&(APCDRV("CHA DISC")'=32)
QUIT
+5 SET APCDRV("CHA")=APCDRV("CHA")+1
+6 QUIT
CHKER ;IHS/CMI/GRL Check for ER visit w/o V ER record
+1 KILL DIR,DA,X,Y
+2 IF $DATA(^AUPNVER("AD",APCDVSIT))
QUIT
+3 WRITE !!,"WARNING ... Emergency Clinic visit with NO ER record!",$CHAR(7),!
+4 SET DIR(0)="Y"
SET DIR("A")="Quit without entering ER Record"
+5 SET DIR("A",1)="ER record with a minimum of Disposition and Departure date and time recommended."
+6 SET DIR("A",2)=""
+7 SET DIR("B")="N"
+8 DO ^DIR
KILL DIR
+9 IF Y=1
QUIT
+10 IF Y=0
SET APCDMPQ=0
QUIT
+11 QUIT
+12 ;
UPDATE ;
+1 KILL DIC,DD,D0,DO
+2 SET X=$$NOW^XLFDT
SET DIC="^AUPNVCA("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9000010.45
SET DIC("DR")=".02////"_$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)_";.03////"_APCDVSIT_";.05////"_DUZ_";1216////"_$$NOW^XLFDT
DO FILE^DICN
+3 IF Y=-1
WRITE !!,"updating status failed"
HANG 2
GOTO UPDATEX
+4 KILL DIC,DD,D0,DIADD,DLAYGO
+5 SET (APCDVCA,DA)=+Y
UPD0 ;EP
+1 KILL DIC,DD,D0,DO
+2 ;
UPD1 ;
+1 DO ^XBFMK
+2 SET DA=APCDVCA
SET DIE="^AUPNVCA("
SET DR=".04"
DO ^DIE
KILL DA,DIE,DR
+3 SET APCDCAR=$PIECE(^AUPNVCA(APCDVCA,0),U,4)
+4 IF APCDCAR=""
WRITE !!,"You must enter a status"
GOTO UPD1
+5 SET APCDERR=$$ERRORCHK^APCDCAF(APCDVSIT)
+6 IF APCDERR]""
IF APCDCAR="R"
WRITE !!,"This visit has the following error: ",APCDERR,!,"You cannot mark a visit as Reviewed/Completed if there is an error."
SET DA=APCDVCA
SET DIE="^AUPNVCA("
SET DR=".04///I"
DO ^DIE
GOTO UPD1
+7 SET DIE="^AUPNVSIT("
SET DA=APCDVSIT
SET DR=".13////"_DT_";1111////"_APCDCAR
DO ^DIE
KILL DIE,DA,DR
+8 IF APCDCAR="R"
DO RNU^APCDCAF4
GOTO UPDATEX
R ;
+1 DO EN^XBNEW("EN^APCDCAF6(APCDVSIT)","APCDVSIT")
+2 IF '$$FINDPEND^APCDCAF6(APCDVSIT)
IF $$VALI^XBDIQ1(9000010,APCDVSIT,1111)'="R"
IF $PIECE(^APCDSITE(DUZ(2),0),U,32)
WRITE !!,"A chart Deficiency reason is required."
HANG 3
GOTO R
+3 ;
UPDATEX ;
+1 KILL DIADD,DLAYGO
+2 DO ^XBFMK
+3 KILL APCDCAR,APCDVCA
+4 QUIT
+5 ;
ADDCANT ;
+1 SET ^AUPNCANT(APCDVSIT,0)=APCDVSIT_U_$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+2 SET DA=APCDVSIT
SET DIK="^AUPNCANT("
DO IX1^DIK
+3 QUIT
