LRIPRE2 ;DALISC/J0 - PURGE OBSOLETE WORKLOAD DATA
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
;
EN ;
Q:'$D(DIFQ)
N LREND
D INIT
D:'LREND PURGE
D WRAPUP
Q
INIT ;
S LREND=0
W !!,"This task is optional. It is intended for test sites who have workload ",!
W "code entries in a format which is now obsolete. If you select this task, ",!
W "files 64.03, 64.1, 64.2 and 67.9 will be erased. In addition the workload ",!
W "code entries for the following files will also be erased: Execute Code ",!
W "(62.07), Etiology (61.2) & Collection Sample (62).",!
W !!
K DIR,X,Y S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
S DIR("A")="Are you sure you want to do this??"
S DIR("?")="Enter 'NO' or '^' or RETURN to skip this optional task."
S DIR("?",1)="Enter 'YES' to purge existing workload code entries."
S DIR("?",2)=""
D ^DIR
I (Y="N")!($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
W !!,"I think I heard you wrong, wouldn't you rather skip this and go for a",!
W "soda or something?",!
K DIR,X,Y S DIR(0)="S^Y:YES;N:NO",DIR("B")="YES"
S DIR("A")="Skip task?"
S DIR("?")="Enter 'YES' or '^' or RETURN to skip this optional task."
S DIR("?",1)="Enter 'No' to proceed with purge."
S DIR("?",2)=""
D ^DIR
I (Y="Y")!($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
W !!,"OK, OK, but remember, you asked for this...(twice even)",!
Q
PURGE ;
W !,"Deleting file 67.9, LAB Monthly Workloads.....",!
K ^LRO(67.9) S ^LRO(67.9,0)="LAB MONTHLY WORKLOADS^67.9P^^"
;
W !,"Deleting file 64.1, Workload [WKLD] Data.....",!
K ^LRO(64.1) S ^LRO(64.1,0)="WORKLOAD [WKLD] DATA^64.1P^^"
;
W !,"Deleting file 64.2, WKLD Suffix Codes.....",!
K ^LAB(64.2) S ^LAB(64.2,0)="WKLD SUFFIX CODES^64.2I^^"
;
W !,"Deleting file 64.03, WKLD LOG FILE.....",!
K ^LRO(64.03) S ^LRO(64.03,0)="WKLD LOG FILE^64.03^"
;
W !,"Cleaning file 62.07, Execute Code.....",!
D CLNEX
W !,"Cleaning file 61.2, Etiology.....",!
D CLNET
W !,"Cleaning file 62, Collection Sample.....",!
D CLNCS
W !,"Workload data cleaning task completed.",!
;
Q
CLNEX ;
N J
F J=0:0 S J=$O(^LAB(62.07,J)) Q:'J K ^LAB(62.07,J,9) W:'J#100 "."
W !
Q
CLNET ;
N J
F J=0:0 S J=$O(^LAB(61.2,J)) Q:'J K ^LAB(61.2,J,9) W:'J#100 "."
W !
Q
CLNCS ;
N J,K
F J=0:0 S J=$O(^LAB(62,J)) Q:'J W:'J#100 "." D
. F K=0:0 S K=$O(^LAB(62,J,1,K)) Q:'K D
. . F L=0:0 S L=$O(^LAB(62,J,1,K,1,L)) Q:'L K ^LAB(62,J,1,K,1,L,1)
W !
Q
WRAPUP ;
K DIR,X,Y
LRIPRE2 ;DALISC/J0 - PURGE OBSOLETE WORKLOAD DATA
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 ;
EN ;
+1 IF '$DATA(DIFQ)
QUIT
+2 NEW LREND
+3 DO INIT
+4 IF 'LREND
DO PURGE
+5 DO WRAPUP
+6 QUIT
INIT ;
+1 SET LREND=0
+2 WRITE !!,"This task is optional. It is intended for test sites who have workload ",!
+3 WRITE "code entries in a format which is now obsolete. If you select this task, ",!
+4 WRITE "files 64.03, 64.1, 64.2 and 67.9 will be erased. In addition the workload ",!
+5 WRITE "code entries for the following files will also be erased: Execute Code ",!
+6 WRITE "(62.07), Etiology (61.2) & Collection Sample (62).",!
+7 WRITE !!
+8 KILL DIR,X,Y
SET DIR(0)="S^Y:YES;N:NO"
SET DIR("B")="NO"
+9 SET DIR("A")="Are you sure you want to do this??"
+10 SET DIR("?")="Enter 'NO' or '^' or RETURN to skip this optional task."
+11 SET DIR("?",1)="Enter 'YES' to purge existing workload code entries."
+12 SET DIR("?",2)=""
+13 DO ^DIR
+14 IF (Y="N")!($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
QUIT
+15 WRITE !!,"I think I heard you wrong, wouldn't you rather skip this and go for a",!
+16 WRITE "soda or something?",!
+17 KILL DIR,X,Y
SET DIR(0)="S^Y:YES;N:NO"
SET DIR("B")="YES"
+18 SET DIR("A")="Skip task?"
+19 SET DIR("?")="Enter 'YES' or '^' or RETURN to skip this optional task."
+20 SET DIR("?",1)="Enter 'No' to proceed with purge."
+21 SET DIR("?",2)=""
+22 DO ^DIR
+23 IF (Y="Y")!($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
QUIT
+24 WRITE !!,"OK, OK, but remember, you asked for this...(twice even)",!
+25 QUIT
PURGE ;
+1 WRITE !,"Deleting file 67.9, LAB Monthly Workloads.....",!
+2 KILL ^LRO(67.9)
SET ^LRO(67.9,0)="LAB MONTHLY WORKLOADS^67.9P^^"
+3 ;
+4 WRITE !,"Deleting file 64.1, Workload [WKLD] Data.....",!
+5 KILL ^LRO(64.1)
SET ^LRO(64.1,0)="WORKLOAD [WKLD] DATA^64.1P^^"
+6 ;
+7 WRITE !,"Deleting file 64.2, WKLD Suffix Codes.....",!
+8 KILL ^LAB(64.2)
SET ^LAB(64.2,0)="WKLD SUFFIX CODES^64.2I^^"
+9 ;
+10 WRITE !,"Deleting file 64.03, WKLD LOG FILE.....",!
+11 KILL ^LRO(64.03)
SET ^LRO(64.03,0)="WKLD LOG FILE^64.03^"
+12 ;
+13 WRITE !,"Cleaning file 62.07, Execute Code.....",!
+14 DO CLNEX
+15 WRITE !,"Cleaning file 61.2, Etiology.....",!
+16 DO CLNET
+17 WRITE !,"Cleaning file 62, Collection Sample.....",!
+18 DO CLNCS
+19 WRITE !,"Workload data cleaning task completed.",!
+20 ;
+21 QUIT
CLNEX ;
+1 NEW J
+2 FOR J=0:0
SET J=$ORDER(^LAB(62.07,J))
IF 'J
QUIT
KILL ^LAB(62.07,J,9)
IF 'J#100
WRITE "."
+3 WRITE !
+4 QUIT
CLNET ;
+1 NEW J
+2 FOR J=0:0
SET J=$ORDER(^LAB(61.2,J))
IF 'J
QUIT
KILL ^LAB(61.2,J,9)
IF 'J#100
WRITE "."
+3 WRITE !
+4 QUIT
CLNCS ;
+1 NEW J,K
+2 FOR J=0:0
SET J=$ORDER(^LAB(62,J))
IF 'J
QUIT
IF 'J#100
WRITE "."
Begin DoDot:1
+3 FOR K=0:0
SET K=$ORDER(^LAB(62,J,1,K))
IF 'K
QUIT
Begin DoDot:2
+4 FOR L=0:0
SET L=$ORDER(^LAB(62,J,1,K,1,L))
IF 'L
QUIT
KILL ^LAB(62,J,1,K,1,L,1)
End DoDot:2
End DoDot:1
+5 WRITE !
+6 QUIT
WRAPUP ;
+1 KILL DIR,X,Y