42 lines
2.1 KiB
Mathematica
42 lines
2.1 KiB
Mathematica
LRARLMW1 ;DALISC/CKA - ARCHIVE LAB MONTHLY WORKLOADS (67.9);2/1/95
|
|
;;5.2;LAB SERVICE;**59**;July 31, 1995
|
|
;FIND ACTIVE LAB ARCHIVAL ACTIVITY
|
|
S LRART=67.9,LRAR=2,LRARC=0 S LRARC=$O(^LAB(95.11,"O",1,LRART,LRARC)) G:LRARC="" ERROR D FILE^LRARU G:'$D(LRARC) EXIT
|
|
;UPDATE ACTION IN PROGRESS FIELDS IN LAB ARCHIVAL ACTIVITY FILE
|
|
S LRAR=2 D MRK^LRARU1
|
|
;CREATE OR REBUILD SORT TEMPLATE CONTAINING ALL INSTITUTIONS
|
|
I $D(^DIBT("B","LR ARCHIVE 67.9")) S LRANUM=$O(^DIBT("B","LR ARCHIVE 67.9",0)) K ^DIBT(LRANUM,1)
|
|
E S DIC="^DIBT(",DIC(0)="L",X="LR ARCHIVE 67.9",DIC("DR")="2///TODAY;4///67.9" D FILE^DICN S LRANUM=$P(Y,U,1)
|
|
S LRAINST=0
|
|
F LRAI=0:0 S LRAINST=$O(^LRO(67.9,"B",LRAINST)) Q:LRAINST="" S ^DIBT(LRANUM,1,LRAINST)=""
|
|
EXTRACT ;Call to extractor
|
|
;Message to user archiving data began
|
|
S LRPED=$P(^LAB(95.11,LRARC,1),U,2),LRPBD=$P(^(1),U)
|
|
W !!?5,"Archiving LAB MONTHLY WORKLOADS file"
|
|
W !?5,"Beginning date: " S Y=LRPBD D DT^DIO2
|
|
W !?5,"Ending date: " S Y=LRPED D DT^DIO2
|
|
RDY S DIR(0)="Y",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE",DIR("B")="NO" D ^DIR K DIR
|
|
I $D(DIRUT)!('Y) D COMP^LRARU1 G EXIT
|
|
QUEUE ;QUEUE MOVING OF DATA TO DESTINATION FILE
|
|
S %ZIS="Q",%ZIS("B")="",%ZIS("A")="Start archiving and PRINT error report on device: " D ^%ZIS
|
|
I POP D COMP^LRARU1 G EXIT
|
|
I $D(IO("Q")) S ZTRTN="START^LRARLMW1",ZTSAVE("LR*")="",ZTDESC="ARCHIVE LAB MONTHLY WORKLOAD",ZTIO=IO D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK D TASK^LRARU1 G EXIT
|
|
START ;ARCHIVING BEGINS
|
|
U IO
|
|
S LRED=LRPED+.99,LRBD=LRPBD-100
|
|
S LRIND(67.911)=1
|
|
DIAXU S LRSCR(67.911)="I $P(^(0),U)<"_LRED_",$P(^(0),U)>"_LRBD
|
|
D EXTRACT^DIAXU(67.9,"[LR ARCHIVE 67.9]","[LRAR ARCHIVE 67.9]","",.LRSCR,.LRIND,"^LAB(95.11,"_LRARC_")","^LAB(95.11,"_LRARC_",""RESULT"")")
|
|
LAAF ;UPDATE ENTRY TO LAB ARCHIVAL ACTIVITY FILE
|
|
S LRAR=2 D UPDATE^LRARU1
|
|
;ARCHIVING ACTION COMPLETED
|
|
D COMP^LRARU1
|
|
S LRARID=LRARC
|
|
D RESULT^LRARREP
|
|
EXIT K DIAXF,DIAXGR,DIAXSCR,DIAXST,DIAXT,DIC,DIR,DIRUT,DTOUT,DUOUT,LRAI,LRAINST,LRANUM,LRAR,LRARC,LRART,LRBD,LRDAT,LRED,LRINST,LRPBD,LRPED,LRSCR,X,X1,X2,Y
|
|
D CLN^LRARU1
|
|
Q
|
|
ERROR W !,$C(7),"I cannot find an archival activity for file 67.9 with the correct archival status."
|
|
G EXIT
|
|
Q
|