source: WorldVistAEHR/trunk/r/SURGERY-SR/SRSUPRG.m@ 1240

Last change on this file since 1240 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1SRSUPRG ;B'HAM ISC/MAM - PURGE UTILIZATION ; [ 10/01/98 11:48 AM ]
2 ;;3.0; Surgery ;**77,50**;24 Jun 93
3 S SRSOUT=0 W @IOF,!,"Purge Utilization Information",!!
4 K %DT S %DT="AEPX",%DT("A")="Starting with Date: " D ^%DT I Y<0 S SRSOUT=1 G END
5 S SRSDT=Y D D^DIQ S SRDATE=Y
6 W !!,"This option will purge all utilization information for the dates prior to (and",!,"including) "_SRDATE_"."
7ASK 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
8 S SRYN=$E(SRYN) I SRYN["?" D HELP G ASK
9 I "YyNn"'[SRYN W !!,"Enter 'YES' to purge information, 'NO' to quit, or '?' for more help." G ASK
10 I "Nn"[SRYN S SRSOUT=1 G END
11 D NOW^%DTC S ZTDTH=%
12 W ! S ZTIO="",ZTRTN="EN^SRSUPRG",(ZTSAVE("SRSDT"),ZTSAVE("SRSITE*"))="",ZTDESC="Purge Surgery Utilization Data" D ^%ZTLOAD
13 W !,"The option to purge utilization data has been queued." G END
14EN ; entry when queued
15 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
16 .K DA,DIK S DA(1)=SRDT,DA=SROOM,DIK="^SRU("_DA(1)_",1," D ^DIK K DA,DIK
17 .I $O(^SRU(SRDT,1,0))="" S DA=SRDT,DIK="^SRU(" D ^DIK K DA,DIK
18 S ZTREQ="@"
19 Q
20END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
21 W @IOF D ^SRSKILL
22 Q
23HELP W !!,"Enter 'YES' to purge utilization information for all dates prior to and",!,"including "_SRDATE_". Enter 'NO' to quit this option."
24 Q
Note: See TracBrowser for help on using the repository browser.