AGFULAUD ;IHS/ASDS/TPF - FULL PATIENT FILE AUDIT USING EDIT CHECK ERRORS/WARNINGS CALLS 6/8/2004 9:49:39 AM
;;7.1;PATIENT REGISTRATION;**8**;AUG 25,2005
;
;#90A IHS/SD/TPF 6/8/2004
;THIS TASK WAS ADDED FAR INTO PROJECT
;TASK #90 WAS COMPLETED BUT WAS NOT THE FUNCTION INTENDED BY THE
;REQUEST
;
;AFTER ADDITONAL SPECIFICATIONS WERE OBTAINED FROM IHS. RUN LASTED 11
;MINUTES FOR SITE WITH 27,000 PATIENT ENTRIES
;
;AG*7.1 IHS/SD/TPF 10/26/2004
ENTER ;
S AGOPT("VERSION")=$$VERSION^XPDUTL("AG") ;GET CURRENT VERSION EDIT CHECKS WILL BE PERFORMED DIFFERENTLY ON SOME FIELDS BECAUSE VERSION 7.1 CHANGED THEIR LOCATION
I AGOPT("VERSION")="" W !,"PATIENT REGISTRATION VERSION CANNOT BE DETERMINED PLEASE CALL THE HELP DESK!!" Q
W !!,"WARNING THIS TASK COULD TAKE UP TO 10 HOURS TO COMPLETE!!!"
W !,"THIS TASK SHOULD BE QUEUED VIA TASKMAN TO RUN AFTER HOURS"
W !,"PREFERABLY ON THE WEEKEND!! MAKE SURE BACKUPS DO NOT SHUTDOWN"
W !,"THIS TASK BEFORE IT'S FINISHED."
I AGOPT("VERSION")<7.1 D
.W !,"YOUR CURRENT VERSION OF IHS PATIENT REGISTRATION IS ",AGOPT("VERSION")
.W !,"THEREFORE THE AUDIT WILL BE PERFORMED BASED ON PRE 7.1 FILE STRUCTURES."
K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="Y"
S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE"
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D EXIT Q
I 'Y D EXIT Q
S ERRDT=$O(^AGERRAUD("B",""),-1)
I ERRDT D I 'LASTFIN W !!,"THE AUDIT REPORT IS CURRENTLY COMPILING! TRY AGAIN LATER" H 3 D EXIT Q
.S DTREC=$O(^AGERRAUD("B",ERRDT,""))
.S LASTFIN=$P($G(^AGERRAUD(DTREC,0)),U,4)
I $D(^AGERRAUD(1,0)) D SHODAT($P($G(^AGERRAUD(1,0)),U)) D I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!('$G(Y)) D EXIT Q
.K DIR,DTOUT,DUOUT,DIRUT,DIROUT
.S DIR(0)="Y"
.S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE"
.D ^DIR
K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="S^T:TASK TO TASKMAN;R:RUN IMMEDIATELY"
S DIR("A")="ACTION"
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D EXIT Q
I Y="R" W !,"STARTING FULL PATIENT FILE AUDIT....." D START Q
S ZTRTN="START^AGFULAUD",ZTDESC="Full Patient File audit by Patient Registration"
S ZTIO=""
S ZTSAVE("AG*")=""
D ^%ZTLOAD
I $D(ZTSK)[0 W !,"Full patient audit canceled!"
E W !!?5,"Full patient audit queued as Task # ",ZTSK,"!"
H 2
D HOME^%ZIS
D EXIT
Q
;
SHODAT(DATE) ;EP
S Y=DATE X ^DD("DD")
W !!,"THERE IS ALREADY AN AUDIT REPORT FROM ",Y,". IT WILL BE DELETED!"
Q
START ;EP - ENTER BELOW FROM TASKMAN OPTION
;KILL PREVIOUS ENTRIES IF THEY EXIST. THIS IS A SNAPSHOT ONLY. WE
;ARE NOT GOING TO ALLOW KEEPING MORE THAN ONE RUN
S STOPFLAG=0
D ^AGVAR ;AG*7.1*8 - Define AGOPT array
;
D CLEAR ;KILL THE CURRENT ENTRY IN THE AUDIT FILE
;IF DATE ENTRY NOT THERE CREATE IT
I '$D(^AGERRAUD("B",DT)) S DTREC=$$NEWDT(DT)
I '$G(DTREC) W:'$D(ZTQUEUED) !,"UNABLE TO CREATE DATE ENTRY IN 'ERROR/WARNING AUDIT' FILE!!" H 3 D EXITCAP Q
E S DTREC=$O(^AGERRAUD("B",DT,""))
I 'DTREC W:'$D(ZTQUEUED) !,"TROUBLE CREATING ENTRY IN 'AG ERROR/WARNING AUDIT' FILE CALL HELP DESK!" Q
;STORE TASK #
S DA=DTREC
S DIE="^AGERRAUD("
S DR=".06////^S X=$G(ZTSK)"
D ^DIE
K MYERRS,MYVARS
D FETCHERR^AGEDERR("ALL",.MYERRS)
S MYVARS("FINDCALL")="",MYVARS("SELECTION")=$G(AGSELECT),MYVARS("SITE")=DUZ(2)
S PDFN=0,SKIP=0,PTTOTAL=0
S TOTALDFN=$P($G(^AUPNPAT(0)),U,4)
F S PDFN=$O(^AUPNPAT(PDFN)) Q:'PDFN D Q:STOPFLAG
.I '$D(ZTQUEUED) W:$P(PDFN/15,".",2)="" "."
.I '$D(ZTQUEUED) W:$P(PDFN/200,".",2)="" !,$J((PDFN/TOTALDFN)*100,3,0)_" % ESTIMATED COMPLETE"
.S STOPFLAG=$$S^%ZTLOAD
.;AG*7.1*8 - Commented out filters - each error already has filters in place and not all errors have the same filters
.;I $$DECEASED^AGEDERR2(PDFN) S SKIP=SKIP+1 Q ;QUIT IF PATIENT DECEASED
.;I '$$CURRUPD^AGEDERR2(PDFN,1095) S SKIP=SKIP+1 Q ;QUIT IF LAST UPDATE>3 YEARS
.;I '$$HASELIG^AGEDERR2(PDFN) S SKIP=SKIP+1 Q ;QUIT IF PATIENT HAS NO ACTIVE INSURANCE ELIGIBILITY PER ADRIAN E-MAIL 2/3/2005
.;I '$$PTACTIVE^AGEDERR2(PDFN) S SKIP=SKIP+1 Q ;QUIT IF PATIENT NOT ACTIVE IN ANY FACILITY
.S PTTOTAL=PTTOTAL+1 ;TOTAL PATIENTS REVIEWED BY ERROR CHECKS
.S (MYVARS("AGPATDFN"),MYVARS("DFN"))=PDFN ;AG*7.1*8 - Added MYVARS("AGPATDFN") set
.D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,0)
.D CAPTURE^AGERRAUD(.MYERRS,PDFN)
I '$D(ZTQUEUED) W !,"100% COMPLETED"
K DIC,DIE
S DIC(0)="EMQ"
S DIC="^AGERRAUD("
S X=DT
D ^DIC
Q:Y<0
S DIE="^AGERRAUD("
S DA=+Y
S DR=".02////^S X=SKIP"
D ^DIE
D NOW^%DTC
S ENDTIME=%
S DIE="^AGERRAUD("
S DR=".04////^S X=ENDTIME"
D ^DIE
S DIE="^AGERRAUD("
S DR=".05////^S X=STOPFLAG"
D ^DIE
S DIE="^AGERRAUD("
S DR=".08////^S X=PTTOTAL"
D ^DIE
S ZTSTOP=STOPFLAG ;PASS STOP FLAG BACK TO TASKMANAGER
Q
EXIT ;EP - CLEAN UP VARIABLES
K DIR,DTOUT,DUOUT,DIRUT,DIROUT,AGOPT("VERSION"),LASTFIN,DTREC,ZTIO,ZTSAVE,Y,ERRDT
Q
CLEAR ;EP - CLEAR THE AUDIT FILE
W:'$D(ZTQUEUED) !,"Clearing audit file for new run."
S DIK="^AGERRAUD("
S ERRDT=""
F S ERRDT=$O(^AGERRAUD("B",ERRDT)) Q:ERRDT="" D
.S DA=$O(^AGERRAUD("B",ERRDT,""))
.D ^DIK
K ^AGERRAUD("D")
K ^AGERRAUD("E")
Q
EXITCAP ;EP
K DTREC,PDFN,PTREC,ERRREC,ERRCODE,AGOPT("VERSION")
Q
NEWDT(DT) ;EP
;SET STARTIME
N STARTIME
D NOW^%DTC
S STARTIME=%
;ADD TOP LEVEL
K DIC,DIE,DR,DA
S DIC=9009061.6
S DIC(0)="L"
S X=DT
D ^DIC
Q:Y<0 0
S DTREC=+Y
S DIE="^AGERRAUD("
S DA=+Y
S DR=".03////^S X=STARTIME"
D ^DIE
Q DTREC
AGFULAUD ;IHS/ASDS/TPF - FULL PATIENT FILE AUDIT USING EDIT CHECK ERRORS/WARNINGS CALLS 6/8/2004 9:49:39 AM
+1 ;;7.1;PATIENT REGISTRATION;**8**;AUG 25,2005
+2 ;
+3 ;#90A IHS/SD/TPF 6/8/2004
+4 ;THIS TASK WAS ADDED FAR INTO PROJECT
+5 ;TASK #90 WAS COMPLETED BUT WAS NOT THE FUNCTION INTENDED BY THE
+6 ;REQUEST
+7 ;
+8 ;AFTER ADDITONAL SPECIFICATIONS WERE OBTAINED FROM IHS. RUN LASTED 11
+9 ;MINUTES FOR SITE WITH 27,000 PATIENT ENTRIES
+10 ;
+11 ;AG*7.1 IHS/SD/TPF 10/26/2004
ENTER ;
+1 ;GET CURRENT VERSION EDIT CHECKS WILL BE PERFORMED DIFFERENTLY ON SOME FIELDS BECAUSE VERSION 7.1 CHANGED THEIR LOCATION
SET AGOPT("VERSION")=$$VERSION^XPDUTL("AG")
+2 IF AGOPT("VERSION")=""
WRITE !,"PATIENT REGISTRATION VERSION CANNOT BE DETERMINED PLEASE CALL THE HELP DESK!!"
QUIT
+3 WRITE !!,"WARNING THIS TASK COULD TAKE UP TO 10 HOURS TO COMPLETE!!!"
+4 WRITE !,"THIS TASK SHOULD BE QUEUED VIA TASKMAN TO RUN AFTER HOURS"
+5 WRITE !,"PREFERABLY ON THE WEEKEND!! MAKE SURE BACKUPS DO NOT SHUTDOWN"
+6 WRITE !,"THIS TASK BEFORE IT'S FINISHED."
+7 IF AGOPT("VERSION")<7.1
Begin DoDot:1
+8 WRITE !,"YOUR CURRENT VERSION OF IHS PATIENT REGISTRATION IS ",AGOPT("VERSION")
+9 WRITE !,"THEREFORE THE AUDIT WILL BE PERFORMED BASED ON PRE 7.1 FILE STRUCTURES."
End DoDot:1
+10 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+11 SET DIR(0)="Y"
+12 SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE"
+13 DO ^DIR
+14 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
DO EXIT
QUIT
+15 IF 'Y
DO EXIT
QUIT
+16 SET ERRDT=$ORDER(^AGERRAUD("B",""),-1)
+17 IF ERRDT
Begin DoDot:1
+18 SET DTREC=$ORDER(^AGERRAUD("B",ERRDT,""))
+19 SET LASTFIN=$PIECE($GET(^AGERRAUD(DTREC,0)),U,4)
End DoDot:1
IF 'LASTFIN
WRITE !!,"THE AUDIT REPORT IS CURRENTLY COMPILING! TRY AGAIN LATER"
HANG 3
DO EXIT
QUIT
+20 IF $DATA(^AGERRAUD(1,0))
DO SHODAT($PIECE($GET(^AGERRAUD(1,0)),U))
Begin DoDot:1
+21 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+22 SET DIR(0)="Y"
+23 SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE"
+24 DO ^DIR
End DoDot:1
IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))!('$GET(Y))
DO EXIT
QUIT
+25 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+26 SET DIR(0)="S^T:TASK TO TASKMAN;R:RUN IMMEDIATELY"
+27 SET DIR("A")="ACTION"
+28 DO ^DIR
+29 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
DO EXIT
QUIT
+30 IF Y="R"
WRITE !,"STARTING FULL PATIENT FILE AUDIT....."
DO START
QUIT
+31 SET ZTRTN="START^AGFULAUD"
SET ZTDESC="Full Patient File audit by Patient Registration"
+32 SET ZTIO=""
+33 SET ZTSAVE("AG*")=""
+34 DO ^%ZTLOAD
+35 IF $DATA(ZTSK)[0
WRITE !,"Full patient audit canceled!"
+36 IF '$TEST
WRITE !!?5,"Full patient audit queued as Task # ",ZTSK,"!"
+37 HANG 2
+38 DO HOME^%ZIS
+39 DO EXIT
+40 QUIT
+41 ;
SHODAT(DATE) ;EP
+1 SET Y=DATE
XECUTE ^DD("DD")
+2 WRITE !!,"THERE IS ALREADY AN AUDIT REPORT FROM ",Y,". IT WILL BE DELETED!"
+3 QUIT
START ;EP - ENTER BELOW FROM TASKMAN OPTION
+1 ;KILL PREVIOUS ENTRIES IF THEY EXIST. THIS IS A SNAPSHOT ONLY. WE
+2 ;ARE NOT GOING TO ALLOW KEEPING MORE THAN ONE RUN
+3 SET STOPFLAG=0
+4 ;AG*7.1*8 - Define AGOPT array
DO ^AGVAR
+5 ;
+6 ;KILL THE CURRENT ENTRY IN THE AUDIT FILE
DO CLEAR
+7 ;IF DATE ENTRY NOT THERE CREATE IT
+8 IF '$DATA(^AGERRAUD("B",DT))
SET DTREC=$$NEWDT(DT)
+9 IF '$GET(DTREC)
IF '$DATA(ZTQUEUED)
WRITE !,"UNABLE TO CREATE DATE ENTRY IN 'ERROR/WARNING AUDIT' FILE!!"
HANG 3
DO EXITCAP
QUIT
+10 IF '$TEST
SET DTREC=$ORDER(^AGERRAUD("B",DT,""))
+11 IF 'DTREC
IF '$DATA(ZTQUEUED)
WRITE !,"TROUBLE CREATING ENTRY IN 'AG ERROR/WARNING AUDIT' FILE CALL HELP DESK!"
QUIT
+12 ;STORE TASK #
+13 SET DA=DTREC
+14 SET DIE="^AGERRAUD("
+15 SET DR=".06////^S X=$G(ZTSK)"
+16 DO ^DIE
+17 KILL MYERRS,MYVARS
+18 DO FETCHERR^AGEDERR("ALL",.MYERRS)
+19 SET MYVARS("FINDCALL")=""
SET MYVARS("SELECTION")=$GET(AGSELECT)
SET MYVARS("SITE")=DUZ(2)
+20 SET PDFN=0
SET SKIP=0
SET PTTOTAL=0
+21 SET TOTALDFN=$PIECE($GET(^AUPNPAT(0)),U,4)
+22 FOR
SET PDFN=$ORDER(^AUPNPAT(PDFN))
IF 'PDFN
QUIT
Begin DoDot:1
+23 IF '$DATA(ZTQUEUED)
IF $PIECE(PDFN/15,".",2)=""
WRITE "."
+24 IF '$DATA(ZTQUEUED)
IF $PIECE(PDFN/200,".",2)=""
WRITE !,$JUSTIFY((PDFN/TOTALDFN)*100,3,0)_" % ESTIMATED COMPLETE"
+25 SET STOPFLAG=$$S^%ZTLOAD
+26 ;AG*7.1*8 - Commented out filters - each error already has filters in place and not all errors have the same filters
+27 ;I $$DECEASED^AGEDERR2(PDFN) S SKIP=SKIP+1 Q ;QUIT IF PATIENT DECEASED
+28 ;I '$$CURRUPD^AGEDERR2(PDFN,1095) S SKIP=SKIP+1 Q ;QUIT IF LAST UPDATE>3 YEARS
+29 ;I '$$HASELIG^AGEDERR2(PDFN) S SKIP=SKIP+1 Q ;QUIT IF PATIENT HAS NO ACTIVE INSURANCE ELIGIBILITY PER ADRIAN E-MAIL 2/3/2005
+30 ;I '$$PTACTIVE^AGEDERR2(PDFN) S SKIP=SKIP+1 Q ;QUIT IF PATIENT NOT ACTIVE IN ANY FACILITY
+31 ;TOTAL PATIENTS REVIEWED BY ERROR CHECKS
SET PTTOTAL=PTTOTAL+1
+32 ;AG*7.1*8 - Added MYVARS("AGPATDFN") set
SET (MYVARS("AGPATDFN"),MYVARS("DFN"))=PDFN
+33 DO EDITCHEK^AGEDERR(.MYERRS,.MYVARS,0)
+34 DO CAPTURE^AGERRAUD(.MYERRS,PDFN)
End DoDot:1
IF STOPFLAG
QUIT
+35 IF '$DATA(ZTQUEUED)
WRITE !,"100% COMPLETED"
+36 KILL DIC,DIE
+37 SET DIC(0)="EMQ"
+38 SET DIC="^AGERRAUD("
+39 SET X=DT
+40 DO ^DIC
+41 IF Y<0
QUIT
+42 SET DIE="^AGERRAUD("
+43 SET DA=+Y
+44 SET DR=".02////^S X=SKIP"
+45 DO ^DIE
+46 DO NOW^%DTC
+47 SET ENDTIME=%
+48 SET DIE="^AGERRAUD("
+49 SET DR=".04////^S X=ENDTIME"
+50 DO ^DIE
+51 SET DIE="^AGERRAUD("
+52 SET DR=".05////^S X=STOPFLAG"
+53 DO ^DIE
+54 SET DIE="^AGERRAUD("
+55 SET DR=".08////^S X=PTTOTAL"
+56 DO ^DIE
+57 ;PASS STOP FLAG BACK TO TASKMANAGER
SET ZTSTOP=STOPFLAG
+58 QUIT
EXIT ;EP - CLEAN UP VARIABLES
+1 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT,AGOPT("VERSION"),LASTFIN,DTREC,ZTIO,ZTSAVE,Y,ERRDT
+2 QUIT
CLEAR ;EP - CLEAR THE AUDIT FILE
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Clearing audit file for new run."
+2 SET DIK="^AGERRAUD("
+3 SET ERRDT=""
+4 FOR
SET ERRDT=$ORDER(^AGERRAUD("B",ERRDT))
IF ERRDT=""
QUIT
Begin DoDot:1
+5 SET DA=$ORDER(^AGERRAUD("B",ERRDT,""))
+6 DO ^DIK
End DoDot:1
+7 KILL ^AGERRAUD("D")
+8 KILL ^AGERRAUD("E")
+9 QUIT
EXITCAP ;EP
+1 KILL DTREC,PDFN,PTREC,ERRREC,ERRCODE,AGOPT("VERSION")
+2 QUIT
NEWDT(DT) ;EP
+1 ;SET STARTIME
+2 NEW STARTIME
+3 DO NOW^%DTC
+4 SET STARTIME=%
+5 ;ADD TOP LEVEL
+6 KILL DIC,DIE,DR,DA
+7 SET DIC=9009061.6
+8 SET DIC(0)="L"
+9 SET X=DT
+10 DO ^DIC
+11 IF Y<0
QUIT 0
+12 SET DTREC=+Y
+13 SET DIE="^AGERRAUD("
+14 SET DA=+Y
+15 SET DR=".03////^S X=STARTIME"
+16 DO ^DIE
+17 QUIT DTREC
