| 1 | LRARPLM ;DALISC/CKA - PURGE LAB MONTHLY WORKLOADS (67.9);2/1/95
 | 
|---|
| 2 |  ;;5.2;LAB SERVICE;**59,162**;Sep 27, 1994
 | 
|---|
| 3 | START ;
 | 
|---|
| 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
 | 
|---|
| 8 | MAKE ;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
 | 
|---|
| 12 | CHECK ;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
 | 
|---|
| 16 | OKAY ;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
 | 
|---|
| 19 | QUEUE ;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 |  ;
 | 
|---|
| 22 | DOIT ;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
 | 
|---|
| 27 | END 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="@"
 | 
|---|
| 36 | EXIT 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
 | 
|---|
| 39 | ERROR W !!,$C(7),"I cannot find an active archival activity for file 67.9!"
 | 
|---|
| 40 |  G EXIT
 | 
|---|
| 41 |  Q
 | 
|---|