source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGSCHAD1.m@ 1141

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1DGSCHAD1 ;ALB/MRL - PURGE SCHEDULED ADMISSIONS ; 06 May 87
2 ;;5.3;Registration;;Aug 13, 1993
3 D:'$D(DT) DT^DICRW S U="^" S:'$D(DTIME) DTIME=999 S IOP="HOME" D ^%ZIS K IOP
4 F I=1:1 S J=$P($T(T+I),";;",2) Q:J']"" W !,J
51 W !! S X1=DT,X2=-90 D C^%DTC S X1=$E(X,1,5)_"01",X2=-1 D C^%DTC S DGPD=X_".2359",Y=X X ^DD("DD") S %DT("A")="Purge Scheduled Admissions Through What Date: ",%DT("B")=Y,%DT="EA" D ^%DT K %DT G Q:Y'>0 S Y=Y_".2359"
6 I Y>DGPD W !?4,"MUST RETAIN LAST 90 DAYS OF SCHEDULED ADMISSION DATA!",*7 G 1
7 I $O(^DGS(41.1,"C",0))>DGPD W !!,"NO ADMISSIONS SCHEDULED ON OR BEFORE " S Y=$P(DGPD,".",1) X ^DD("DD") W Y,".",*7 G Q
8 S ION="",DGPD=Y,DGVAR="DGPD",DGPGM="S^DGSCHAD1" D QUE^DGUTQ G Q:POP U IO
9Q K %DT,X1,X2,X,DGPD,Y,J,I,DGPGM,DGVAR D CLOSE^DGUTQ Q
10S F DGD=0:0 S DGD=$O(^DGS(41.1,"C",DGD)) Q:'DGD!(DGD>DGPD) F DGD1=0:0 S DGD1=$O(^DGS(41.1,"C",DGD,DGD1)) Q:DGD1'>0 I $D(^DGS(41.1,DGD1,0)) S DIK="^DGS(41.1,",DA=DGD1 D ^DIK K DIK
11 G Q
12T ;
13 ;;This routine is designed to purge your scheduled admissions file of old data.
14 ;;You will be asked to select the data through which you wish to purge. This date
15 ;;must be at least 90 days into the past. Once the date is selected you will be
16 ;;asked to confirm that you indeed wish to purge all data through that date and
17 ;;the process will then commence. This procedure is performed as a background job
18 ;;therefore output device selection will not be necessary.
Note: See TracBrowser for help on using the repository browser.