Routine: SRSUPRG

SRSUPRG ;B'HAM ISC/MAM - PURGE UTILIZATION ; [ 10/01/98  11:48 AM ]

 ;;3.0; Surgery ;**77,50**;24 Jun 93

 S SRSOUT=0 W @IOF,!,"Purge Utilization Information",!!

 K %DT S %DT="AEPX",%DT("A")="Starting with Date: " D ^%DT I Y<0 S SRSOUT=1 G END

 S SRSDT=Y D D^DIQ S SRDATE=Y

 W !!,"This option will purge all utilization information for the dates prior to (and",!,"including) "_SRDATE_"."

ASK W !!,"Are you sure that you want to purge for this date range ?  NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END

 S SRYN=$E(SRYN) I SRYN["?" D HELP G ASK

 I "YyNn"'[SRYN W !!,"Enter 'YES' to purge information, 'NO' to quit, or '?' for more help." G ASK

 I "Nn"[SRYN S SRSOUT=1 G END

 D NOW^%DTC S ZTDTH=%

 W ! S ZTIO="",ZTRTN="EN^SRSUPRG",(ZTSAVE("SRSDT"),ZTSAVE("SRSITE*"))="",ZTDESC="Purge Surgery Utilization Data" D ^%ZTLOAD

 W !,"The option to purge utilization data has been queued." G END

EN ; entry when queued

 S SRSOUT=0,SRDT=0 F  S SRDT=$O(^SRU(SRDT)) Q:'SRDT!(SRDT>SRSDT)  S SROOM=0 F  S SROOM=$O(^SRU(SRDT,1,SROOM)) Q:'SROOM  I $$ORDIV^SROUTL0(SROOM,$G(SRSITE("DIV"))) D

 .K DA,DIK S DA(1)=SRDT,DA=SROOM,DIK="^SRU("_DA(1)_",1," D ^DIK K DA,DIK

 .I $O(^SRU(SRDT,1,0))="" S DA=SRDT,DIK="^SRU(" D ^DIK K DA,DIK

 S ZTREQ="@"

END I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME

 W @IOF D ^SRSKILL

HELP W !!,"Enter 'YES' to purge utilization information for all dates prior to and",!,"including "_SRDATE_".  Enter 'NO' to quit this option."

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSUPRG   1484     printed  Apr 09, 2024@21:49:34                                                                                                                                                                                                     Page 2

SRSUPRG   ;B'HAM ISC/MAM - PURGE UTILIZATION ; [ 10/01/98  11:48 AM ]

 +1       ;;3.0; Surgery ;**77,50**;24 Jun 93

 +2        SET SRSOUT=0

           WRITE @IOF,!,"Purge Utilization Information",!!

 +3        KILL %DT

           SET %DT="AEPX"

           SET %DT("A")="Starting with Date: "

           DO ^%DT

           IF Y<0

               SET SRSOUT=1

               GOTO END

 +4        SET SRSDT=Y

           DO D^DIQ

           SET SRDATE=Y

 +5        WRITE !!,"This option will purge all utilization information for the dates prior to (and",!,"including) "_SRDATE_"."

ASK        WRITE !!,"Are you sure that you want to purge for this date range ?  NO// "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRSOUT=1

               GOTO END

 +1        SET SRYN=$EXTRACT(SRYN)

           IF SRYN["?"

               DO HELP

               GOTO ASK

 +2        IF "YyNn"'[SRYN

               WRITE !!,"Enter 'YES' to purge information, 'NO' to quit, or '?' for more help."

               GOTO ASK

 +3        IF "Nn"[SRYN

               SET SRSOUT=1

               GOTO END

 +4        DO NOW^%DTC

           SET ZTDTH=%

 +5        WRITE !

           SET ZTIO=""

           SET ZTRTN="EN^SRSUPRG"

           SET (ZTSAVE("SRSDT"),ZTSAVE("SRSITE*"))=""

           SET ZTDESC="Purge Surgery Utilization Data"

           DO ^%ZTLOAD

 +6        WRITE !,"The option to purge utilization data has been queued."

           GOTO END

EN        ; entry when queued

 +1        SET SRSOUT=0

           SET SRDT=0

FOR

               SET SRDT=$ORDER(^SRU(SRDT))

               if 'SRDT!(SRDT>SRSDT)

                   QUIT

               SET SROOM=0

FOR

                   SET SROOM=$ORDER(^SRU(SRDT,1,SROOM))

                   if 'SROOM

                       QUIT

                   IF $$ORDIV^SROUTL0(SROOM,$GET(SRSITE("DIV")))

                       Begin DoDot:1

 +2                        KILL DA,DIK

                           SET DA(1)=SRDT

                           SET DA=SROOM

                           SET DIK="^SRU("_DA(1)_",1,"

                           DO ^DIK

                           KILL DA,DIK

 +3                        IF $ORDER(^SRU(SRDT,1,0))=""

                               SET DA=SRDT

                               SET DIK="^SRU("

                               DO ^DIK

                               KILL DA,DIK

                       End DoDot:1

 +4        SET ZTREQ="@"

 +5        QUIT

END        IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

 +1        WRITE @IOF

           DO ^SRSKILL

 +2        QUIT

HELP       WRITE !!,"Enter 'YES' to purge utilization information for all dates prior to and",!,"including "_SRDATE_".  Enter 'NO' to quit this option."

 +1        QUIT

SRSUPRG.m