| 1 | LRARWKD ;DALISC/CKA - ARCHIVE WKLD DATA (64.1);2/1/95
|
|---|
| 2 | ;;5.2;LAB SERVICE;**59**;July 31, 1995
|
|---|
| 3 | S LRART=64.1,LRARFL="" D CHECK^LRARU G:LRARFL=1 EXIT
|
|---|
| 4 | S LRAR=1 D NEW^LRARU
|
|---|
| 5 | DATE ;Called from LR ARCHIVE 64.1 option
|
|---|
| 6 | ;Message
|
|---|
| 7 | W !!,"First enter a date range selection to archive the"
|
|---|
| 8 | W !,"WKLD DATA file (64.1)."
|
|---|
| 9 | ;Prompt for a range of dates
|
|---|
| 10 | D DT^DICRW
|
|---|
| 11 | BEGDT W !!,"**** Date Range Selection ****",! S %DT="AE",%DT(0)="-T",%DT("A")="Beginning DATE: " D ^%DT
|
|---|
| 12 | I Y<0 D DELETE G:LRARFL BEGDT G EXIT
|
|---|
| 13 | S LRPBD=Y,LRBD=LRPBD-.0001
|
|---|
| 14 | ENDDT W ! S %DT="AE",%DT("A")="Ending DATE: " D ^%DT
|
|---|
| 15 | I Y<0 D DELETE G:LRARFL ENDDT G EXIT
|
|---|
| 16 | G:Y<LRBD HELP W ! S LRPED=Y,LRED=LRPED+.99
|
|---|
| 17 | ;SAVE SELECTION CRITERIA IN LAB ARCHIVAL ACTIVITY FILE
|
|---|
| 18 | D SAVESEL^LRARU1
|
|---|
| 19 | ;OPTIONAL PRINT SELECTED ENTRIES
|
|---|
| 20 | ASKPRT S DIR(0)="Y",DIR("A")="WOULD YOU LIKE TO PRINT SELECTED ENTRIES",DIR("B")="YES" D ^DIR
|
|---|
| 21 | I $D(DIRUT)!('Y) G COMP
|
|---|
| 22 | PRT ;EN1^DIP CALL
|
|---|
| 23 | S L=0,DIC="^LRO(64.1,",BY=".01,.03,.01",FR=","_LRPBD,TO=","_LRPED
|
|---|
| 24 | D EN1^DIP
|
|---|
| 25 | COMP ;ARCHIVING ACTION COMPLETED
|
|---|
| 26 | D COMP^LRARU1
|
|---|
| 27 | EXIT K BY,DA,DIC,DIR,DIRUT,DTOUT,DUOUT,FR,L,LRAR,LRARC,LRARFL,LRARI,LRART,LRARX,LRBD,LRED,LRPBD,LRPED,TO,Y
|
|---|
| 28 | D CLN^LRARU1
|
|---|
| 29 | Q
|
|---|
| 30 | HELP W "??",!?5,"Ending date must not be on or before beginning date" G DATE
|
|---|
| 31 | CLEAR ;REMOVE DATA FROM ARCHIVED WKLD DATA FILE
|
|---|
| 32 | ;CHECK LAB ARCHIVAL ACTIVITY FILE
|
|---|
| 33 | W !!,"This will clear the data from the Archived Wkld Data file."
|
|---|
| 34 | ASKCLR K DIR S DIR(0)="Y",DIR("A")="ARE YOU SURE YOU WANT TO DO THIS",DIR("B")="YES" D ^DIR K DIR
|
|---|
| 35 | I $D(DIRUT)!('Y) G EXIT
|
|---|
| 36 | S LRAR=3,LRART=64.1,LRARC=0 S LRARC=$O(^LAB(95.11,"O",2,LRART,LRARC)) G:LRARC="" ERROR D FILE^LRARU G:'$D(LRARC) EXIT
|
|---|
| 37 | ;CLEARING IN PROGRESS
|
|---|
| 38 | D MRK^LRARU1
|
|---|
| 39 | W !!,"I will now CLEAR out the global."
|
|---|
| 40 | S LRARX="" F LRARI=0:0 S LRARX=$O(^LAR(64.19999,LRARX)) Q:LRARX="" K ^LAR(64.19999,LRARX)
|
|---|
| 41 | S ^LAR(64.19999,0)="ARCHIVED WKLD DATA^64.19999"
|
|---|
| 42 | W !!,">>> DONE <<<"
|
|---|
| 43 | ;UPDATE ENTRY IN LAB ARCHIVAL ACTIVITY FILE
|
|---|
| 44 | S LRAR=3 D UPDATE^LRARU1
|
|---|
| 45 | D COMP^LRARU1
|
|---|
| 46 | D CLN^LRARU1
|
|---|
| 47 | Q
|
|---|
| 48 | DELETE K DIR S LRARFL="",DIR(0)="Y",DIR("A")="Do you want to delete this archival activity and forget this for now",DIR("B")="YES"
|
|---|
| 49 | D ^DIR
|
|---|
| 50 | I $D(DIRUT)!('Y) W !,"You must enter a beginning and ending date." S LRARFL=1 Q
|
|---|
| 51 | W !!,"Now deleting this archival activity..."
|
|---|
| 52 | S DIK="^LAB(95.11,",DA=LRARC D ^DIK W !!,">>> DONE <<<"
|
|---|
| 53 | Q
|
|---|
| 54 | ERROR W !!,$C(7),"I cannot find an archival activity for file 64.1 with the correct archival status."
|
|---|
| 55 | G EXIT
|
|---|
| 56 | Q
|
|---|
| 57 | ;LRARC=LAB ARCHIVAL ACTIVITY INTERNAL FILE #
|
|---|
| 58 | ;LRARFL= OUTSTANDING ARCHIVAL ACTIVITY FLAG
|
|---|
| 59 | Q
|
|---|
