- LRARPW ; IHS/DIR/AAB - PURGE WKLD DATA (64.1) ; [ 07/22/2002 1:11 PM ]
- ;;5.2;LR;**1002,1003,1013**;JUL 15, 2002
- ;;5.2;LAB SERVICE;**59,162**;Sep 27, 1994
- START ;
- ;FIND ACTIVE LAB ARCHIVAL ACTIVITY
- S LRART=64.1,LRAR=90,LRARC=0 S LRARC=$O(^LAB(95.11,"O",3,LRART,LRARC)) G:LRARC="" ERROR D FILE^LRARU G:'$D(LRARC) EXIT
- ;UPDATE ACTION IN PROGRESS FIELDS
- S LRAR=90 D MRK^LRARU1
- MAKE ;Ask if backup tape made
- W !!!! S DIR(0)="Y",DIR("A")="Did you make a backup of the ARCHIVED WKLD DATA file (64.19999)" D ^DIR K DIR
- I $D(DIRUT) D COMP^LRARU1 G EXIT
- I 'Y W !!!!,$C(7),"Make a backup of the ARCHIVED WKLD DATA file before purging!" D COMP^LRARU1 G EXIT
- CHECK ;Ask if checked backup tape
- W !!!! S DIR(0)="Y",DIR("A")="Did you check the backup of the ARCHIVED WKLD DATA file" D ^DIR K DIR
- I $D(DIRUT) D COMP^LRARU1 G EXIT
- I 'Y W !!!!,$C(7),"Check the backup before purging!" D COMP^LRARU1 G EXIT
- OKAY ;Ask if okay to delete
- W !!!! S DIR(0)="Y",DIR("A")="Okay to delete WKLD DATA entries: " D ^DIR K DIR
- I $D(DIRUT)!('Y) W !!!!,"No purging done." D COMP^LRARU1 G EXIT
- QUEUE ;queue purge
- S ZTRTN="DOIT^LRARPW",ZTSAVE("LR*")="",ZTDESC="PURGE ARCHIVED WKLD DATA",ZTIO="" D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK G EXIT
- ;
- DOIT ;Deleting dates in 64.1
- S LRAVAR=0
- F LRAI=0:0 S LRAVAR=$O(^LAB(95.11,LRARC,"RESULT",64.111,LRAVAR)) Q:+LRAVAR'>0 D
- . S DA(2)=$P(LRAVAR,",",3),DA(1)=$P(LRAVAR,",",2),DA=$P(LRAVAR,","),DIK="^LRO(64.1,"_DA(2)_",1,"_DA(1)_",1," D ^DIK
- . I '$O(^LRO(64.1,DA(2),1,DA(1),1,0)) S DA=DA(1),DA(1)=DA(2),DIK="^LRO(64.1,"_DA(1)_",1," D ^DIK
- END W !!!!,"DONE."
- D COMP^LRARU1
- I '$D(DIRUT) S LRAR=90 D UPDATE^LRARU1
- W !!,"I will now CLEAR out the Archived Workload Data global."
- S LRARX="" F LRARI=0:0 S LRARX=$O(^LAR(64.19999,LRARX)) Q:LRARX="" K ^LAR(64.19999,LRARX)
- S ^LAR(64.19999,0)="ARCHIVED WKLD DATA^64.19999"
- W !!,">>> DONE <<<"
- K ^LAB(95.11,LRARC,"RESULT")
- S ZTREQ="@"
- EXIT K DA,DIK,DIR,DIRUT,LRAVAR,LRAI,LRAIEN,LRAINST,LRAJ,LRAR,LRARC,LRARI,LRART,LRARX,Y
- D CLN^LRARU1
- Q
- ERROR W !!,$C(7),"I cannot find an archival activity for file 64.1 with the right archival status."
- G EXIT
- Q
- LRARPW ; IHS/DIR/AAB - PURGE WKLD DATA (64.1) ; [ 07/22/2002 1:11 PM ]
- +1 ;;5.2;LR;**1002,1003,1013**;JUL 15, 2002
- +2 ;;5.2;LAB SERVICE;**59,162**;Sep 27, 1994
- START ;
- +1 ;FIND ACTIVE LAB ARCHIVAL ACTIVITY
- +2 SET LRART=64.1
- SET LRAR=90
- SET LRARC=0
- SET LRARC=$ORDER(^LAB(95.11,"O",3,LRART,LRARC))
- IF LRARC=""
- GOTO ERROR
- DO FILE^LRARU
- IF '$DATA(LRARC)
- GOTO EXIT
- +3 ;UPDATE ACTION IN PROGRESS FIELDS
- +4 SET LRAR=90
- DO MRK^LRARU1
- MAKE ;Ask if backup tape made
- +1 WRITE !!!!
- SET DIR(0)="Y"
- SET DIR("A")="Did you make a backup of the ARCHIVED WKLD DATA file (64.19999)"
- DO ^DIR
- KILL DIR
- +2 IF $DATA(DIRUT)
- DO COMP^LRARU1
- GOTO EXIT
- +3 IF 'Y
- WRITE !!!!,$CHAR(7),"Make a backup of the ARCHIVED WKLD DATA file before purging!"
- DO COMP^LRARU1
- GOTO EXIT
- CHECK ;Ask if checked backup tape
- +1 WRITE !!!!
- SET DIR(0)="Y"
- SET DIR("A")="Did you check the backup of the ARCHIVED WKLD DATA file"
- DO ^DIR
- KILL DIR
- +2 IF $DATA(DIRUT)
- DO COMP^LRARU1
- GOTO EXIT
- +3 IF 'Y
- WRITE !!!!,$CHAR(7),"Check the backup before purging!"
- DO COMP^LRARU1
- GOTO EXIT
- OKAY ;Ask if okay to delete
- +1 WRITE !!!!
- SET DIR(0)="Y"
- SET DIR("A")="Okay to delete WKLD DATA entries: "
- DO ^DIR
- KILL DIR
- +2 IF $DATA(DIRUT)!('Y)
- WRITE !!!!,"No purging done."
- DO COMP^LRARU1
- GOTO EXIT
- QUEUE ;queue purge
- +1 SET ZTRTN="DOIT^LRARPW"
- SET ZTSAVE("LR*")=""
- SET ZTDESC="PURGE ARCHIVED WKLD DATA"
- SET ZTIO=""
- DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"TASK #",ZTSK
- GOTO EXIT
- +2 ;
- DOIT ;Deleting dates in 64.1
- +1 SET LRAVAR=0
- +2 FOR LRAI=0:0
- SET LRAVAR=$ORDER(^LAB(95.11,LRARC,"RESULT",64.111,LRAVAR))
- IF +LRAVAR'>0
- QUIT
- Begin DoDot:1
- +3 SET DA(2)=$PIECE(LRAVAR,",",3)
- SET DA(1)=$PIECE(LRAVAR,",",2)
- SET DA=$PIECE(LRAVAR,",")
- SET DIK="^LRO(64.1,"_DA(2)_",1,"_DA(1)_",1,"
- DO ^DIK
- +4 IF '$ORDER(^LRO(64.1,DA(2),1,DA(1),1,0))
- SET DA=DA(1)
- SET DA(1)=DA(2)
- SET DIK="^LRO(64.1,"_DA(1)_",1,"
- DO ^DIK
- End DoDot:1
- END WRITE !!!!,"DONE."
- +1 DO COMP^LRARU1
- +2 IF '$DATA(DIRUT)
- SET LRAR=90
- DO UPDATE^LRARU1
- +3 WRITE !!,"I will now CLEAR out the Archived Workload Data global."
- +4 SET LRARX=""
- FOR LRARI=0:0
- SET LRARX=$ORDER(^LAR(64.19999,LRARX))
- IF LRARX=""
- QUIT
- KILL ^LAR(64.19999,LRARX)
- +5 SET ^LAR(64.19999,0)="ARCHIVED WKLD DATA^64.19999"
- +6 WRITE !!,">>> DONE <<<"
- +7 KILL ^LAB(95.11,LRARC,"RESULT")
- +8 SET ZTREQ="@"
- EXIT KILL DA,DIK,DIR,DIRUT,LRAVAR,LRAI,LRAIEN,LRAINST,LRAJ,LRAR,LRARC,LRARI,LRART,LRARX,Y
- +1 DO CLN^LRARU1
- +2 QUIT
- ERROR WRITE !!,$CHAR(7),"I cannot find an archival activity for file 64.1 with the right archival status."
- +1 GOTO EXIT
- +2 QUIT
