source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRARWKD1.m@ 724

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1LRARWKD1 ;DALISC/CKA - ARCHIVE WKLD DATA (64.1);2/1/95
2 ;;5.2;LAB SERVICE;**59**;July 31, 1995
3 ;FIND ACTIVE LAB ARCHIVAL ACTIVITY
4 S LRART=64.1,LRAR=2,LRARC=0 S LRARC=$O(^LAB(95.11,"O",1,LRART,LRARC)) G:LRARC="" ERROR D FILE^LRARU G:'$D(LRARC) EXIT
5 ;UPDATE ACTION IN PROGRESS FIELDS IN LAB ARCHIVAL ACTIVITY FILE
6 S LRAR=2 D MRK^LRARU1
7 ;CREATE OR REBUILD SORT TEMPLATE CONTAINING ALL INSTITUTIONS
8 I $D(^DIBT("B","LR ARCHIVE WKLD DATA 64.1")) S LRANUM=$O(^DIBT("B","LR ARCHIVE WKLD DATA 64.1",0)) K ^DIBT(LRANUM,1)
9 E S DIC="^DIBT(",DIC(0)="L",X="LR ARCHIVE WKLD DATA 64.1",DIC("DR")="2///TODAY;4///64.1" D FILE^DICN S LRANUM=$P(Y,U,1)
10 S LRAINST=0
11 F LRAI=0:0 S LRAINST=$O(^LRO(64.1,"B",LRAINST)) Q:LRAINST="" S ^DIBT(LRANUM,1,LRAINST)=""
12EXTRACT ;Call to extractor
13 ;Message to user archiving data began
14 S LRPED=+$P(^LAB(95.11,LRARC,1),U,2),LRPBD=$P(^(1),U)
15 W !!?5,"Archiving WKLD DATA file"
16 W !?5,"Beginning date: " S Y=LRPBD D DT^DIO2
17 W !?5,"Ending date: " S Y=LRPED D DT^DIO2
18RDY S DIR(0)="Y",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE",DIR("B")="NO" D ^DIR K DIR
19 I $D(DIRUT)!('Y) D COMP^LRARU1 G EXIT
20QUEUE ;QUEUE MOVING OF DATA TO DESTINATION FILE IN BACKGROUND
21 S %ZIS="Q",%ZIS("B")="",%ZIS("A")="Start archiving and PRINT error report on device: " D ^%ZIS
22 I POP D COMP^LRARU1 G EXIT
23 I $D(IO("Q")) S ZTRTN="START^LRARWKD1",ZTSAVE("LR*")="",ZTDESC="ARCHIVE WKLD DATA",ZTIO=IO D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK D TASK^LRARU1 G EXIT
24START ;ARCHIVING BEGINS
25 U IO
26 S LRED=LRPED+.99,LRBD=LRPBD-.0001
27 S LRIND(64.111)=1
28DIAXU S LRSCR(64.11)="I $P(^(0),U)<"_LRED_",$P(^(0),U)>"_LRBD
29 D EXTRACT^DIAXU(64.1,"[LR ARCHIVE WKLD DATA 64.1]","[LRAR ARCHIVE WKLD DATA 64.1]","",.LRSCR,.LRIND,"^LAB(95.11,"_LRARC_")","^LAB(95.11,"_LRARC_",""RESULT"")")
30LAAF ;UPDATE ENTRY TO LAB ARCHIVAL ACTIVITY FILE
31 S LRAR=2 D UPDATE^LRARU1
32 ;ARCHIVING ACTION COMPLETED
33 D COMP^LRARU1
34 S LRARID=LRARC
35 D RESULT^LRARREP
36EXIT K DIC,DIR,DIRUT,DTOUT,DUOUT,LRAI,LRAINST,LRANUM,LRAR,LRARC,LRART,LRDAT,LRIND,LRPBD,LRPED,LRSCR,X,Y
37 D CLN^LRARU1
38 Q
39ERROR W !!,$C(7),"I cannot find an archival activity for file 64.1 with the correct archival status."
40 G EXIT
41 Q
Note: See TracBrowser for help on using the repository browser.