AGFULAUD.m

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