source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRARLMW.m@ 635

Last change on this file since 635 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1LRARLMW ;DALISC/CKA - ARCHIVE LAB MONTHLY WORKLOADS (67.9);2/1/95
2 ;;5.2;LAB SERVICE;**59**;July 31, 1995
3 S LRART=67.9,LRARFL="" D CHECK^LRARU G:LRARFL=1 EXIT
4 S LRAR=1 D NEW^LRARU
5DATE ;Called from LR ARCHIVE 67.9 option
6 ;Message
7 W !!,"First enter a date range selection to archive the"
8 W !,"LAB MONTHLY WORKLOADS file (67.9)."
9 ;Prompt for a range of dates
10 D DT^DICRW
11BEGDT 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-100
14ENDDT 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
20ASKPRT S DIR(0)="Y",DIR("A")="WOULD YOU LIKE TO PRINT SELECTED ENTRIES",DIR("B")="YES" D ^DIR K DIR
21 I $D(DIRUT)!('Y) G COMP
22PRT ;EN1^DIP CALL
23 S L=0,DIC="^LRO(67.9,",BY=".01,1,1,.01",FR=","_LRBD,TO=","_LRED
24 D EN1^DIP
25COMP ;ARCHIVING ACTION COMPLETED
26 D COMP^LRARU1
27EXIT K BY,DA,DIC,DIK,DIR,DIRUT,DTOUT,DUOUT,FR,L,LRARF,LRAI,LRAINST,LRANUM,LRAR,LRARC,LRARFL,LRARI,LRARP,LRARST,LRART,LRARU,LRARX,LRBD,LRED,LRPBD,LRPED,TO,Y
28 D CLN^LRARU1
29 Q
30DELETE K DIR S LRARFL=0,DIR(0)="Y",DIR("A")="Do you want to delete this archival activity and forget this for now",DIR("B")="YES"
31 D ^DIR
32 I $D(DIRUT)!('Y) W !,"You must enter a beginning and ending date." S LRARFL=1 Q
33 W !!,"Now deleting this archival activity..."
34 S DIK="^LAB(95.11,",DA=LRARC D ^DIK W !!,">>> DONE <<<"
35 Q
36HELP W "??",!?5,"Ending date must not be on or before beginning date" G DATE
37CLEAR ;REMOVE DATA FROM ARCHIVED LAB MONTHLY WORKLOADS FILE
38 ;CHECK LAB ARCHIVAL ACTIVITY FILE
39 W !!,"This will clear the data from the Archived Lab Monthly Workloads file."
40ASKCLR K DIR S DIR(0)="Y",DIR("A")="ARE YOU SURE YOU WANT TO DO THIS",DIR("B")="YES" D ^DIR K DIR
41 I $D(DIRUT)!('Y) G EXIT
42 S LRAR=3,LRART=67.9,LRARC=0 S LRARC=$O(^LAB(95.11,"O",2,LRART,LRARC)) G:LRARC="" ERROR D FILE^LRARU G:'$D(LRARC) EXIT
43 ;CLEARING IN PROGRESS
44 D MRK^LRARU1
45 W !!,"I will now CLEAR out the global."
46 S LRARX="" F LRARI=0:0 S LRARX=$O(^LAR(67.99999,LRARX)) Q:LRARX="" K ^LAR(67.99999,LRARX)
47 S ^LAR(67.99999,0)="ARCHIVED LAB MONTHLY WORKLOADS^67.99999"
48 ;UPDATE ENTRY IN LAB ARCHIVAL ACTIVITY FILE
49 S LRAR=3 D UPDATE^LRARU1
50 D COMP^LRARU1
51 W !!,">>> DONE <<<"
52 G EXIT
53 Q
54ERROR W !!,$C(7),"I cannot find an archival activity for file 67.9 that has the correct archival status."
55 G EXIT
56 Q
57 ;LRARC=LAB ARCHIVAL ACTIVITY INTERNAL FILE #
58 ;LRARFL= OUTSTANDING ARCHIVAL ACTIVITY FLAG
59 Q
Note: See TracBrowser for help on using the repository browser.