source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRARU.m

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1LRARU ;DALISC/CKA - LAB ARCHIVING MISC. ;4/19/95
2 ;;5.2;LAB SERVICE;**59,150**;July 31, 1995
3NEW ;SET UP INITIAL ARCHIVAL ACTIVITY
4 ;CALLED FROM LRARWKD,LRARLMW,LRARBI
5 ;LRART=FILE # OF FILE BEING ARCHIVED
6 D NOW^%DTC
7 S X=$P(^LAB(95.11,0),U,3) F X=X:1 L +^LAB(95.11,X):0 Q:$T&'$D(^(X)) L -^LAB(95.11,X)
8 S Z="1////"_LRART_";4////"_DT_$S($D(^VA(200)):";7////1;7.5////"_DUZ,1:"")_";12////"_LRAR_";13////"_%_$S($D(^VA(200)):";14////"_DUZ,1:"")_";15////"_$S(LRART=64.1:64.19999,LRART=65:65.9999,LRART=67.9:67.99999,1:0)
9 S DINUM=X,DIC("DR")=Z
10 K DD,DO S DIC="^LAB(95.11,",DLAYGO=95.11,DIC(0)="L"
11 D FILE^DICN S LRARC=+Y K DIC,DINUM,DLAYGO,DR,X,Z
12 Q
13 ;
14FILE ;LOOKUP LAB ARCHIVING ACTIVITY
15 S DIC="^LAB(95.11,"
16 I $D(LRARFL1) S DIC("S")="I $P(^(0),U,2)=LRART"
17 I LRAR=""!(LRAR=99) S DIC(0)="AEQIMZ" I '$D(DIC("A")) S DIC("A")="Select LAB ARCHIVAL ACTIVITY: "
18 I LRAR'="",LRAR'=99 S DIC(0)="Z",X=LRARC
19 D ^DIC K DIC I Y<0!$D(DUOUT)!$D(DTOUT) K LRARC Q
20 I $P(Y(0),U,14) D ER1 K LRARC Q
21 S LRARC=+Y,LRARF=$P(Y(0),U,2),LRARU=$P(Y(0),U,3),LRARP=$P(Y(0),U,4),LRARST=$P(Y(0),U,8)
22 I LRAR=LRARST D ER3 K LRARC Q
23 I LRAR=90,LRARST=90!(LRARST="") D ER4 K LRARC Q
24 I LRAR=99 D:LRARST=3 MSG I LRARST>6 D ER5 K LRARC Q
25 Q
26 ;
27CHECK ;Check LAB ARCHIVAL ACTIVITY FILE
28 I $D(^LAB(95.11,"C",LRART)) D
29 . S LRARC=0 F X=0:0 S LRARC=$O(^LAB(95.11,"C",LRART,LRARC)) Q:LRARC="" S LRARST=$P(^LAB(95.11,LRARC,0),U,8) I LRARST>0,LRARST'=90 D
30 .. W !!!!,$C(7),"There is an outstanding archival activity."
31 .. W !,"Please finish or cancel this activity before you begin another."
32 .. W !!
33 .. S LRARFL=1
34 K LRARST,X
35 Q
36ENTC ;CANCEL
37 S LRAR=99,DIC("A")="CANCEL WHICH LAB ARCHIVING SELECTION: " D FILE^LRARU G EXIT:'$D(LRARC)
38 S DIR("A")="Are you sure you want to CANCEL this LAB ARCHIVING ACTIVITY",DIR("B")="NO",DIR(0)="Y"
39 S DIR("??")="^W !!?5,""Enter YES to stop this activity and start again from the beginning."""
40 D ^DIR G EXIT:$D(DUOUT)!$D(DTOUT),EXIT:'Y
41 D MRK^LRARU1
42 S DIK="^LAB(95.11,",DA=LRARC D ^DIK
43 S LRARNRB=0 I $S(LRARF=64.1:$P($G(^LAR(64.19999,0)),U,4),LRARF=67.9:$P($G(^LAR(67.99999,0)),U,4),LRARF=65:$P($G(^LRD(65.9999,0)),U,4)) D ASK G EXIT:$D(DUOUT)!$D(DTOUT) I 'LRARNRB D KILL
44 D COMP^LRARU1
45 W !!,">>> DONE <<<"
46 G EXIT
47 Q
48ER1 W $C(7),!!!,"The following Archival Activity is in progress--no access allowed!",!
49 S LRARX=Y(0),Y=$P(Y(0),U,14),C=$P(^DD(95.11,13,0),U,2) D Y^DIQ W Y_" STARTED: " S Y=$P(LRARX,U,14) X:Y ^DD("DD") W Y_" BY: " W:$D(^VA(200,+$P(LRARX,U,15),0)) $P(^(0),U,1) W ! Q
50ER3 S:LRARST=90 LRARST=4 W !!,$C(7),"This activity has already been "_$P($P($P(^DD(95.11,7,0),U,3),";",LRARST),":",2),"!" Q
51ER4 W !!,$C(7),"Data ALREADY purged!",! Q
52ER5 W !!,$C(7),"Cannot cancel archiving record after archiving has been complete--this now",!,"acts as your history!!" Q
53MSG W !!,$C(7),"Just a reminder--you have already archived these records to permanent storage.",!,"You probably won't want to save the sequential storage media since you",!,"are cancelling this archiving activity!!",! Q
54 Q
55ASK W !!,$C(7),"This archival activity has already updated the archived file.",!
56 S DIR("A")="Delete the archived file entries created by this lab archival activity",DIR("B")="YES",DIR(0)="Y"
57 S DIR("??")="^W !!?5,""Enter YES to rollback the archived file to its state before the update."""
58 D ^DIR I 'Y S LRARNRB=1
59 Q
60KILL W !!,"I will now CLEAR out the global."
61 G:LRARF=64.1 AWD G:LRARF=67.9 ALMW G:LRARF=65 ABI
62 Q
63AWD S LRARX="" F LRARI=0:0 S LRARX=$O(^LAR(64.19999,LRARX)) Q:LRARX="" K ^LAR(64.19999,LRARX)
64 S ^LAR(64.19999,0)="ARCHIVED WKLD DATA^64.19999"
65 Q
66ALMW S LRARX="" F LRARI=0:0 S LRARX=$O(^LAR(67.99999,LRARX)) Q:LRARX="" K ^LAR(67.99999,LRARX)
67 S ^LAR(67.99999,0)="ARCHIVED LAB MONTHLY WORKLOADS^67.99999"
68 Q
69ABI S LRARX="" F LRARI=0:0 S LRARX=$O(^LRD(65.9999,LRARX)) Q:LRARX="" K ^LRD(65.9999,LRARX)
70 S ^LRD(65.9999,0)="ARCHIVED BLOOD INVENTORY^65.9999"
71 Q
72DEV ;ASK ARCHIVE DEVICE LABEL AND STORE IN ARCHIVAL ACTIVITY FILE
73 S DIR(0)="95.11,16" D ^DIR
74 G:$D(DUOUT)!($D(DTOUT))!(Y="") EXIT K DIR
75 S DA=LRARC,DIE="^LAB(95.11,",DR="16////"_Y
76 D ^DIE
77 G EXIT
78 Q
79DEL ;DELETE ARCHIVED FILE ENTRIES AFTER ARCHIVAL ACTIVITY IS CANCELED
80 S DIR(0)="S^1:ARCHIVED WKLD DATA;2:ARCHIVED LAB MONTHLY WORKLOADS"
81 S DIR("A")="FILE"
82 D ^DIR K DIR
83 I $D(DIRUT)!('Y) G EXIT
84 S LRART=$S(Y=1:64.1,Y=2:67.9,1:0)
85 I 'LRART G EXIT
86 I '$P($G(^LAR(LRART_"9999",0)),U,4) W $C(7),!!,"No data in file.",! G EXIT
87 S LRARFL=""
88 I $D(^LAB(95.11,"C",LRART)) D
89 . S LRARC=0 F X=0:0 S LRARC=$O(^LAB(95.11,"C",LRART,LRARC)) Q:LRARC="" S LRARST=$P(^LAB(95.11,LRARC,0),U,8) I LRARST>0,LRARST'=90 D
90 .. W !!!!,$C(7),"There is an outstanding archival activity."
91 .. S LRARFL=1
92 K LRARST,X
93 I LRARFL W !!,"This option is for use only after the archival activity is canceled.",! G EXIT
94 S LRARF=LRART
95 D KILL
96 W !!,"Done."
97EXIT K DA,DIC,DIE,DIK,DIR,D0,DR,DTOUT,DUOUT,LRAR,LRARC,LRARF,LRARI,LRARNRB,LRARP,LRARST,LRARU,LRARX,Y
98 D CLN^LRARU1
99 Q
Note: See TracBrowser for help on using the repository browser.