source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRARPLM.m@ 1667

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1LRARPLM ;DALISC/CKA - PURGE LAB MONTHLY WORKLOADS (67.9);2/1/95
2 ;;5.2;LAB SERVICE;**59,162**;Sep 27, 1994
3START ;
4 ;FIND ACTIVE LAB ARCHIVAL ACTIVITY
5 S LRART=67.9,LRAR=90,LRARC=0 S LRARC=$O(^LAB(95.11,"O",3,LRART,LRARC)) G:LRARC="" ERROR D FILE^LRARU G:'$D(LRARC) EXIT
6 ;UPDATE ACTION IN PROGRESS FIELDS
7 S LRAR=90 D MRK^LRARU1
8MAKE ;Ask if backup tape made
9 W !!!! S DIR(0)="Y",DIR("A")="Did you make a backup of the ARCHIVED LAB MONTHLY WORKLOADS file (67.99999)" D ^DIR K DIR
10 I $D(DIRUT) D COMP^LRARU1 G EXIT
11 I 'Y W !!!!,$C(7),"Make a backup of the ARCHIVED LAB MONTHLY WORKLOADS file before purging!" D COMP^LRARU1 G EXIT
12CHECK ;Ask if checked backup tape
13 W !!!! S DIR(0)="Y",DIR("A")="Did you check the backup of the ARCHIVED LAB MONTHLY WORKLOADS file" D ^DIR K DIR
14 I $D(DIRUT) D COMP^LRARU1 G EXIT
15 I 'Y W !!!!,$C(7),"Check the backup before purging!" D COMP^LRARU1 G EXIT
16OKAY ;Ask if okay to delete
17 W !!!! S DIR(0)="Y",DIR("A")="Okay to delete LAB MONTHLY WORKLOADS entries: " D ^DIR K DIR
18 I $D(DIRUT)!('Y) W !!!!,"No purging done." D COMP^LRARU1 G EXIT
19QUEUE ;queue purge
20 S ZTRTN="DOIT^LRARPLM",ZTSAVE("LR*")="",ZTDESC="PURGE ARCHIVED WKLD DATA",ZTIO="" D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK G EXIT
21 ;
22DOIT ;Deleting dates in 67.9
23 S LRAIEN=0
24 F LRAI=0:0 S LRAIEN=$O(^LAB(95.11,LRARC,"RESULT",67.911,LRAIEN)) Q:+LRAIEN'>0 D
25 . S DA(2)=$P(LRAIEN,",",3),DA(1)=$P(LRAIEN,",",2),DA=$P(LRAIEN,",")
26 . S DIK="^LRO(67.9,"_DA(2)_",1,"_DA(1)_",1," D ^DIK
27END W !!!!,"DONE."
28 D COMP^LRARU1
29 I '$D(DIRUT) S LRAR=90 D UPDATE^LRARU1
30 W !!,"I will now CLEAR out the Archived Lab Monthly Workloads global."
31 S LRARX="" F LRARI=0:0 S LRARX=$O(^LAR(67.99999,LRARX)) Q:LRARX="" K ^LAR(67.99999,LRARX)
32 S ^LAR(67.99999,0)="ARCHIVED LAB MONTHLY WORKLOADS^67.99999"
33 W !!,">>> DONE <<<"
34 K ^LAB(95.11,LRARC,"RESULT")
35 S ZTREQ="@"
36EXIT K DA,DIK,DIR,DIRUT,LRADATE,LRADIV,LRADIVN,LRAI,LRAIEN,LRAINST,LRAJ,LRAK,LRAR,LRARC,LRARF,LRARI,LRARP,LRARST,LRART,LRARU,LRARX,Y
37 D CLN^LRARU1
38 Q
39ERROR W !!,$C(7),"I cannot find an active archival activity for file 67.9!"
40 G EXIT
41 Q
Note: See TracBrowser for help on using the repository browser.