- 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
