APCHPWHP.m

APCHPWHP ; IHS/CMI/LAB - PURGE FORMS TRACKING DATA ;

 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009;Build 1

 D INIT

 D GETDATE

 I $D(APCHQUIT) D EOJ Q

CONT ;

 S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I 'Y D EOJ Q

 I $D(DIRUT) D EOJ Q

DRIVER ;

 D PURGE

 W !!,"A Total of ",APCHCNT," Entries Purged.",!

 D EOJ

 Q

 ;

INIT ;

 W !!,"Purging Patient Wellness Handout Log!"

 W !!,"This option is used to purge the file that maintains an entry each time a"

 W !,"patient wellness handout is generated.  This log can grow very large over"

 W !,"time and older data can be purged from the file if that is desired.  It is"

 W !,"not necessary to do this but it will free up space on the disk drive.  If"

 W !,"you purge this file you will no longer be able to get a tally of handouts"

 W !,"generated for the date range that has been purged.",!

 S APCHCNT=0

 K APCHQUIT

 Q

 ;

GETDATE ;

 S Y=DT X ^DD("DD") S APCHDTP=Y

 S %DT("A")="Purge log up to and including what PWH Generation DATE?  ",%DT="AEPX" W ! D ^%DT

 I Y=-1 S APCHQUIT="" Q

 S APCHPGE=Y X ^DD("DD") S APCHPGEY=Y

 Q

 ;

PURGE ;

 S APCHX=0 F  S APCHX=$O(^APCHPWHL("AC",APCHX)) Q:APCHX=""!(APCHX>APCHPGE)  D

 .S APCHY=0 F  S APCHY=$O(^APCHPWHL("AC",APCHX,APCHY)) S APCHCNT=APCHCNT+1 S DA=APCHY,DIK="^APCHPWHL(" D ^DIK

 .I '(APCDCNT#100) W "."

 Q

 ;

 ;

EOJ ;

 K APCHCNT,APCHPGE,X,Y,DIC,DA,DIE,DR,%DT,D,D0,D1,DQ,APCHDTP,APCHPGEY,POP,APCHX,APCHDUZ,APCHY

 I $D(ZTQUEUED) S ZTREQ="@" K ZTSK

 D ^%ZISC

 Q

APCHPWHP  ; IHS/CMI/LAB - PURGE FORMS TRACKING DATA ;

 +1       ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009;Build 1

 +2        DO INIT

 +3        DO GETDATE

 +4        IF $DATA(APCHQUIT)

               DO EOJ

               QUIT 

CONT      ;

 +1        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to continue"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF 'Y

               DO EOJ

               QUIT 

 +3        IF $DATA(DIRUT)

               DO EOJ

               QUIT 

DRIVER    ;

 +1        DO PURGE

 +2        WRITE !!,"A Total of ",APCHCNT," Entries Purged.",!

 +3        DO EOJ

 +4        QUIT 

 +5       ;

INIT      ;

 +1        WRITE !!,"Purging Patient Wellness Handout Log!"

 +2        WRITE !!,"This option is used to purge the file that maintains an entry each time a"

 +3        WRITE !,"patient wellness handout is generated.  This log can grow very large over"

 +4        WRITE !,"time and older data can be purged from the file if that is desired.  It is"

 +5        WRITE !,"not necessary to do this but it will free up space on the disk drive.  If"

 +6        WRITE !,"you purge this file you will no longer be able to get a tally of handouts"

 +7        WRITE !,"generated for the date range that has been purged.",!

 +8        SET APCHCNT=0

 +9        KILL APCHQUIT

 +10       QUIT 

 +11      ;

GETDATE   ;

 +1        SET Y=DT

           XECUTE ^DD("DD")

           SET APCHDTP=Y

 +2        SET %DT("A")="Purge log up to and including what PWH Generation DATE?  "

           SET %DT="AEPX"

           WRITE !

           DO ^%DT

 +3        IF Y=-1

               SET APCHQUIT=""

               QUIT 

 +4        SET APCHPGE=Y

           XECUTE ^DD("DD")

           SET APCHPGEY=Y

 +5        QUIT 

 +6       ;

PURGE     ;

 +1        SET APCHX=0

           FOR 

               SET APCHX=$ORDER(^APCHPWHL("AC",APCHX))

               IF APCHX=""!(APCHX>APCHPGE)

                   QUIT 

               Begin DoDot:1

 +2                SET APCHY=0

                   FOR 

                       SET APCHY=$ORDER(^APCHPWHL("AC",APCHX,APCHY))

                       SET APCHCNT=APCHCNT+1

                       SET DA=APCHY

                       SET DIK="^APCHPWHL("

                       DO ^DIK

 +3                IF '(APCDCNT#100)

                       WRITE "."

               End DoDot:1

 +4        QUIT 

 +5       ;

 +6       ;

EOJ       ;

 +1        KILL APCHCNT,APCHPGE,X,Y,DIC,DA,DIE,DR,%DT,D,D0,D1,DQ,APCHDTP,APCHPGEY,POP,APCHX,APCHDUZ,APCHY

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               KILL ZTSK

 +3        DO ^%ZISC

 +4        QUIT