APCDFPRG.m

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

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 D INIT

 D GETDATE

 I $D(APCDQUIT) D EOJ Q

ZIS W !! S %ZIS="PQ" D ^%ZIS

 I POP D EOJ Q

 I $D(IO("Q")) D TSKMN,EOJ Q

DRIVER ;

 D PURGE

 W !!,"A Total of ",APCDCNT," Dates Purged.",!

 D EOJ

 Q

 ;

INIT ;

 W !!,"Purging Data from Forms Tracking File!"

 S APCDCNT=0

 K APCDQUIT

 Q

 ;

GETDATE ;

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

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

 I Y=-1 S APCDQUIT="" Q

 S APCDPGE=Y X ^DD("DD") S APCDPGEY=Y

 Q

 ;

PURGE ;

 S APCDX=0 F  S APCDX=$O(^APCDFORM("B",APCDX)) Q:APCDX=""!(APCDX>APCDPGE)  S APCDY=$O(^APCDFORM("B",APCDX,"")) I APCDY]"" D KILL

 Q

 ;

KILL ;

 K DIE,DIU,DIV,DA,X,Y

 S DIE="^APCDFORM(",DA=APCDY,DR=".01///@" D ^DIE

 I $D(Y),'$D(ZTSK) W !,"****ERROR DELETING POSTING DATE ",APCDX," ***** - Notify Programmer!" Q

 K DIE,DR,DA,X,Y

 S APCDCNT=APCDCNT+1

 Q

 ;

TSKMN ;

 K ZTSAVE F %="APCDPGE","APCDCNT" S ZTSAVE(%)=""

 S ZTIO=ION,ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCDFPRG",ZTDTH="",ZTDESC="PURGE DATA ENTRY FORMS FILE" D ^%ZTLOAD

 Q

EOJ ;

 K APCDCNT,APCDPGE,X,Y,DIC,DA,DIE,DR,%DT,D,D0,D1,DQ,APCDDTP,APCDPGEY,POP,APCDX,APCDDUZ,APCDY

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

 D ^%ZISC

 Q

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

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2        DO INIT

 +3        DO GETDATE

 +4        IF $DATA(APCDQUIT)

               DO EOJ

               QUIT 

ZIS        WRITE !!

           SET %ZIS="PQ"

           DO ^%ZIS

 +1        IF POP

               DO EOJ

               QUIT 

 +2        IF $DATA(IO("Q"))

               DO TSKMN

               DO EOJ

               QUIT 

DRIVER    ;

 +1        DO PURGE

 +2        WRITE !!,"A Total of ",APCDCNT," Dates Purged.",!

 +3        DO EOJ

 +4        QUIT 

 +5       ;

INIT      ;

 +1        WRITE !!,"Purging Data from Forms Tracking File!"

 +2        SET APCDCNT=0

 +3        KILL APCDQUIT

 +4        QUIT 

 +5       ;

GETDATE   ;

 +1        SET Y=DT

           XECUTE ^DD("DD")

           SET APCDDTP=Y

 +2        SET %DT("A")="Purge forms up to and including what POSTING DATE?  "

           SET %DT="AEPX"

           WRITE !

           DO ^%DT

 +3        IF Y=-1

               SET APCDQUIT=""

               QUIT 

 +4        SET APCDPGE=Y

           XECUTE ^DD("DD")

           SET APCDPGEY=Y

 +5        QUIT 

 +6       ;

PURGE     ;

 +1        SET APCDX=0

           FOR 

               SET APCDX=$ORDER(^APCDFORM("B",APCDX))

               IF APCDX=""!(APCDX>APCDPGE)

                   QUIT 

               SET APCDY=$ORDER(^APCDFORM("B",APCDX,""))

               IF APCDY]""

                   DO KILL

 +2        QUIT 

 +3       ;

KILL      ;

 +1        KILL DIE,DIU,DIV,DA,X,Y

 +2        SET DIE="^APCDFORM("

           SET DA=APCDY

           SET DR=".01///@"

           DO ^DIE

 +3        IF $DATA(Y)

               IF '$DATA(ZTSK)

                   WRITE !,"****ERROR DELETING POSTING DATE ",APCDX," ***** - Notify Programmer!"

                   QUIT 

 +4        KILL DIE,DR,DA,X,Y

 +5        SET APCDCNT=APCDCNT+1

 +6        QUIT 

 +7       ;

TSKMN     ;

 +1        KILL ZTSAVE

           FOR %="APCDPGE","APCDCNT"

               SET ZTSAVE(%)=""

 +2        SET ZTIO=ION

           SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="DRIVER^APCDFPRG"

           SET ZTDTH=""

           SET ZTDESC="PURGE DATA ENTRY FORMS FILE"

           DO ^%ZTLOAD

 +3        QUIT 

EOJ       ;

 +1        KILL APCDCNT,APCDPGE,X,Y,DIC,DA,DIE,DR,%DT,D,D0,D1,DQ,APCDDTP,APCDPGEY,POP,APCDX,APCDDUZ,APCDY

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               KILL ZTSK

 +3        DO ^%ZISC

 +4        QUIT