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="@"
Q
END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
W @IOF D ^SRSKILL
Q
HELP W !!,"Enter 'YES' to purge utilization information for all dates prior to and",!,"including "_SRDATE_". Enter 'NO' to quit this option."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSUPRG 1484 printed Nov 22, 2024@17:57:47 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
