LRARU ;DALISC/CKA - LAB ARCHIVING MISC. ;4/19/95
;;5.2;LAB SERVICE;**59,150**;July 31, 1995
NEW ;SET UP INITIAL ARCHIVAL ACTIVITY
;CALLED FROM LRARWKD,LRARLMW,LRARBI
;LRART=FILE # OF FILE BEING ARCHIVED
D NOW^%DTC
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)
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)
S DINUM=X,DIC("DR")=Z
K DD,DO S DIC="^LAB(95.11,",DLAYGO=95.11,DIC(0)="L"
D FILE^DICN S LRARC=+Y K DIC,DINUM,DLAYGO,DR,X,Z
Q
;
FILE ;LOOKUP LAB ARCHIVING ACTIVITY
S DIC="^LAB(95.11,"
I $D(LRARFL1) S DIC("S")="I $P(^(0),U,2)=LRART"
I LRAR=""!(LRAR=99) S DIC(0)="AEQIMZ" I '$D(DIC("A")) S DIC("A")="Select LAB ARCHIVAL ACTIVITY: "
I LRAR'="",LRAR'=99 S DIC(0)="Z",X=LRARC
D ^DIC K DIC I Y<0!$D(DUOUT)!$D(DTOUT) K LRARC Q
I $P(Y(0),U,14) D ER1 K LRARC Q
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)
I LRAR=LRARST D ER3 K LRARC Q
I LRAR=90,LRARST=90!(LRARST="") D ER4 K LRARC Q
I LRAR=99 D:LRARST=3 MSG I LRARST>6 D ER5 K LRARC Q
Q
;
CHECK ;Check LAB ARCHIVAL ACTIVITY FILE
I $D(^LAB(95.11,"C",LRART)) D
. 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
.. W !!!!,$C(7),"There is an outstanding archival activity."
.. W !,"Please finish or cancel this activity before you begin another."
.. W !!
.. S LRARFL=1
K LRARST,X
Q
ENTC ;CANCEL
S LRAR=99,DIC("A")="CANCEL WHICH LAB ARCHIVING SELECTION: " D FILE^LRARU G EXIT:'$D(LRARC)
S DIR("A")="Are you sure you want to CANCEL this LAB ARCHIVING ACTIVITY",DIR("B")="NO",DIR(0)="Y"
S DIR("??")="^W !!?5,""Enter YES to stop this activity and start again from the beginning."""
D ^DIR G EXIT:$D(DUOUT)!$D(DTOUT),EXIT:'Y
D MRK^LRARU1
S DIK="^LAB(95.11,",DA=LRARC D ^DIK
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
D COMP^LRARU1
W !!,">>> DONE <<<"
G EXIT
Q
ER1 W $C(7),!!!,"The following Archival Activity is in progress--no access allowed!",!
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
ER3 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
ER4 W !!,$C(7),"Data ALREADY purged!",! Q
ER5 W !!,$C(7),"Cannot cancel archiving record after archiving has been complete--this now",!,"acts as your history!!" Q
MSG 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
Q
ASK W !!,$C(7),"This archival activity has already updated the archived file.",!
S DIR("A")="Delete the archived file entries created by this lab archival activity",DIR("B")="YES",DIR(0)="Y"
S DIR("??")="^W !!?5,""Enter YES to rollback the archived file to its state before the update."""
D ^DIR I 'Y S LRARNRB=1
Q
KILL W !!,"I will now CLEAR out the global."
G:LRARF=64.1 AWD G:LRARF=67.9 ALMW G:LRARF=65 ABI
Q
AWD S LRARX="" F LRARI=0:0 S LRARX=$O(^LAR(64.19999,LRARX)) Q:LRARX="" K ^LAR(64.19999,LRARX)
S ^LAR(64.19999,0)="ARCHIVED WKLD DATA^64.19999"
Q
ALMW S LRARX="" F LRARI=0:0 S LRARX=$O(^LAR(67.99999,LRARX)) Q:LRARX="" K ^LAR(67.99999,LRARX)
S ^LAR(67.99999,0)="ARCHIVED LAB MONTHLY WORKLOADS^67.99999"
Q
ABI S LRARX="" F LRARI=0:0 S LRARX=$O(^LRD(65.9999,LRARX)) Q:LRARX="" K ^LRD(65.9999,LRARX)
S ^LRD(65.9999,0)="ARCHIVED BLOOD INVENTORY^65.9999"
Q
DEV ;ASK ARCHIVE DEVICE LABEL AND STORE IN ARCHIVAL ACTIVITY FILE
S DIR(0)="95.11,16" D ^DIR
G:$D(DUOUT)!($D(DTOUT))!(Y="") EXIT K DIR
S DA=LRARC,DIE="^LAB(95.11,",DR="16////"_Y
D ^DIE
G EXIT
Q
DEL ;DELETE ARCHIVED FILE ENTRIES AFTER ARCHIVAL ACTIVITY IS CANCELED
S DIR(0)="S^1:ARCHIVED WKLD DATA;2:ARCHIVED LAB MONTHLY WORKLOADS"
S DIR("A")="FILE"
D ^DIR K DIR
I $D(DIRUT)!('Y) G EXIT
S LRART=$S(Y=1:64.1,Y=2:67.9,1:0)
I 'LRART G EXIT
I '$P($G(^LAR(LRART_"9999",0)),U,4) W $C(7),!!,"No data in file.",! G EXIT
S LRARFL=""
I $D(^LAB(95.11,"C",LRART)) D
. 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
.. W !!!!,$C(7),"There is an outstanding archival activity."
.. S LRARFL=1
K LRARST,X
I LRARFL W !!,"This option is for use only after the archival activity is canceled.",! G EXIT
S LRARF=LRART
D KILL
W !!,"Done."
EXIT K DA,DIC,DIE,DIK,DIR,D0,DR,DTOUT,DUOUT,LRAR,LRARC,LRARF,LRARI,LRARNRB,LRARP,LRARST,LRARU,LRARX,Y
D CLN^LRARU1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARU 5024 printed Dec 13, 2024@02:09:35 Page 2
LRARU ;DALISC/CKA - LAB ARCHIVING MISC. ;4/19/95
+1 ;;5.2;LAB SERVICE;**59,150**;July 31, 1995
NEW ;SET UP INITIAL ARCHIVAL ACTIVITY
+1 ;CALLED FROM LRARWKD,LRARLMW,LRARBI
+2 ;LRART=FILE # OF FILE BEING ARCHIVED
+3 DO NOW^%DTC
+4 SET X=$PIECE(^LAB(95.11,0),U,3)
FOR X=X:1
LOCK +^LAB(95.11,X):0
if $TEST&'$DATA(^(X))
QUIT
LOCK -^LAB(95.11,X)
+5 SET Z="1////"_LRART_";4////"_DT_$SELECT($DATA(^VA(200)):";7////1;7.5////"_DUZ,1:"")_";12////"_LRAR_";13////"_%_$SELECT($DATA(^VA(200)):";14////"_DUZ,1:"")_";15////"_$SELECT(LRART=64.1:64.19999,LRART=65:65.9999,LRART=67.9:67.99999,1:0)
+6 SET DINUM=X
SET DIC("DR")=Z
+7 KILL DD,DO
SET DIC="^LAB(95.11,"
SET DLAYGO=95.11
SET DIC(0)="L"
+8 DO FILE^DICN
SET LRARC=+Y
KILL DIC,DINUM,DLAYGO,DR,X,Z
+9 QUIT
+10 ;
FILE ;LOOKUP LAB ARCHIVING ACTIVITY
+1 SET DIC="^LAB(95.11,"
+2 IF $DATA(LRARFL1)
SET DIC("S")="I $P(^(0),U,2)=LRART"
+3 IF LRAR=""!(LRAR=99)
SET DIC(0)="AEQIMZ"
IF '$DATA(DIC("A"))
SET DIC("A")="Select LAB ARCHIVAL ACTIVITY: "
+4 IF LRAR'=""
IF LRAR'=99
SET DIC(0)="Z"
SET X=LRARC
+5 DO ^DIC
KILL DIC
IF Y<0!$DATA(DUOUT)!$DATA(DTOUT)
KILL LRARC
QUIT
+6 IF $PIECE(Y(0),U,14)
DO ER1
KILL LRARC
QUIT
+7 SET LRARC=+Y
SET LRARF=$PIECE(Y(0),U,2)
SET LRARU=$PIECE(Y(0),U,3)
SET LRARP=$PIECE(Y(0),U,4)
SET LRARST=$PIECE(Y(0),U,8)
+8 IF LRAR=LRARST
DO ER3
KILL LRARC
QUIT
+9 IF LRAR=90
IF LRARST=90!(LRARST="")
DO ER4
KILL LRARC
QUIT
+10 IF LRAR=99
if LRARST=3
DO MSG
IF LRARST>6
DO ER5
KILL LRARC
QUIT
+11 QUIT
+12 ;
CHECK ;Check LAB ARCHIVAL ACTIVITY FILE
+1 IF $DATA(^LAB(95.11,"C",LRART))
Begin DoDot:1
+2 SET LRARC=0
FOR X=0:0
SET LRARC=$ORDER(^LAB(95.11,"C",LRART,LRARC))
if LRARC=""
QUIT
SET LRARST=$PIECE(^LAB(95.11,LRARC,0),U,8)
IF LRARST>0
IF LRARST'=90
Begin DoDot:2
+3 WRITE !!!!,$CHAR(7),"There is an outstanding archival activity."
+4 WRITE !,"Please finish or cancel this activity before you begin another."
+5 WRITE !!
+6 SET LRARFL=1
End DoDot:2
End DoDot:1
+7 KILL LRARST,X
+8 QUIT
ENTC ;CANCEL
+1 SET LRAR=99
SET DIC("A")="CANCEL WHICH LAB ARCHIVING SELECTION: "
DO FILE^LRARU
if '$DATA(LRARC)
GOTO EXIT
+2 SET DIR("A")="Are you sure you want to CANCEL this LAB ARCHIVING ACTIVITY"
SET DIR("B")="NO"
SET DIR(0)="Y"
+3 SET DIR("??")="^W !!?5,""Enter YES to stop this activity and start again from the beginning."""
+4 DO ^DIR
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
if 'Y
GOTO EXIT
+5 DO MRK^LRARU1
+6 SET DIK="^LAB(95.11,"
SET DA=LRARC
DO ^DIK
+7 SET LRARNRB=0
IF $SELECT(LRARF=64.1:$PIECE($GET(^LAR(64.19999,0)),U,4),LRARF=67.9:$PIECE($GET(^LAR(67.99999,0)),U,4),LRARF=65:$PIECE($GET(^LRD(65.9999,0)),U,4))
DO ASK
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
IF 'LRARNRB
DO KILL
+8 DO COMP^LRARU1
+9 WRITE !!,">>> DONE <<<"
+10 GOTO EXIT
+11 QUIT
ER1 WRITE $CHAR(7),!!!,"The following Archival Activity is in progress--no access allowed!",!
+1 SET LRARX=Y(0)
SET Y=$PIECE(Y(0),U,14)
SET C=$PIECE(^DD(95.11,13,0),U,2)
DO Y^DIQ
WRITE Y_" STARTED: "
SET Y=$PIECE(LRARX,U,14)
if Y
XECUTE ^DD("DD")
WRITE Y_" BY: "
if $DATA(^VA(200,+$PIECE(LRARX,U,15),0))
WRITE $PIECE(^(0),U,1)
WRITE !
QUIT
ER3 if LRARST=90
SET LRARST=4
WRITE !!,$CHAR(7),"This activity has already been "_$PIECE($PIECE($PIECE(^DD(95.11,7,0),U,3),";",LRARST),":",2),"!"
QUIT
ER4 WRITE !!,$CHAR(7),"Data ALREADY purged!",!
QUIT
ER5 WRITE !!,$CHAR(7),"Cannot cancel archiving record after archiving has been complete--this now",!,"acts as your history!!"
QUIT
MSG WRITE !!,$CHAR(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!!",!
QUIT
+1 QUIT
ASK WRITE !!,$CHAR(7),"This archival activity has already updated the archived file.",!
+1 SET DIR("A")="Delete the archived file entries created by this lab archival activity"
SET DIR("B")="YES"
SET DIR(0)="Y"
+2 SET DIR("??")="^W !!?5,""Enter YES to rollback the archived file to its state before the update."""
+3 DO ^DIR
IF 'Y
SET LRARNRB=1
+4 QUIT
KILL WRITE !!,"I will now CLEAR out the global."
+1 if LRARF=64.1
GOTO AWD
if LRARF=67.9
GOTO ALMW
if LRARF=65
GOTO ABI
+2 QUIT
AWD SET LRARX=""
FOR LRARI=0:0
SET LRARX=$ORDER(^LAR(64.19999,LRARX))
if LRARX=""
QUIT
KILL ^LAR(64.19999,LRARX)
+1 SET ^LAR(64.19999,0)="ARCHIVED WKLD DATA^64.19999"
+2 QUIT
ALMW SET LRARX=""
FOR LRARI=0:0
SET LRARX=$ORDER(^LAR(67.99999,LRARX))
if LRARX=""
QUIT
KILL ^LAR(67.99999,LRARX)
+1 SET ^LAR(67.99999,0)="ARCHIVED LAB MONTHLY WORKLOADS^67.99999"
+2 QUIT
ABI SET LRARX=""
FOR LRARI=0:0
SET LRARX=$ORDER(^LRD(65.9999,LRARX))
if LRARX=""
QUIT
KILL ^LRD(65.9999,LRARX)
+1 SET ^LRD(65.9999,0)="ARCHIVED BLOOD INVENTORY^65.9999"
+2 QUIT
DEV ;ASK ARCHIVE DEVICE LABEL AND STORE IN ARCHIVAL ACTIVITY FILE
+1 SET DIR(0)="95.11,16"
DO ^DIR
+2 if $DATA(DUOUT)!($DATA(DTOUT))!(Y="")
GOTO EXIT
KILL DIR
+3 SET DA=LRARC
SET DIE="^LAB(95.11,"
SET DR="16////"_Y
+4 DO ^DIE
+5 GOTO EXIT
+6 QUIT
DEL ;DELETE ARCHIVED FILE ENTRIES AFTER ARCHIVAL ACTIVITY IS CANCELED
+1 SET DIR(0)="S^1:ARCHIVED WKLD DATA;2:ARCHIVED LAB MONTHLY WORKLOADS"
+2 SET DIR("A")="FILE"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)!('Y)
GOTO EXIT
+5 SET LRART=$SELECT(Y=1:64.1,Y=2:67.9,1:0)
+6 IF 'LRART
GOTO EXIT
+7 IF '$PIECE($GET(^LAR(LRART_"9999",0)),U,4)
WRITE $CHAR(7),!!,"No data in file.",!
GOTO EXIT
+8 SET LRARFL=""
+9 IF $DATA(^LAB(95.11,"C",LRART))
Begin DoDot:1
+10 SET LRARC=0
FOR X=0:0
SET LRARC=$ORDER(^LAB(95.11,"C",LRART,LRARC))
if LRARC=""
QUIT
SET LRARST=$PIECE(^LAB(95.11,LRARC,0),U,8)
IF LRARST>0
IF LRARST'=90
Begin DoDot:2
+11 WRITE !!!!,$CHAR(7),"There is an outstanding archival activity."
+12 SET LRARFL=1
End DoDot:2
End DoDot:1
+13 KILL LRARST,X
+14 IF LRARFL
WRITE !!,"This option is for use only after the archival activity is canceled.",!
GOTO EXIT
+15 SET LRARF=LRART
+16 DO KILL
+17 WRITE !!,"Done."
EXIT KILL DA,DIC,DIE,DIK,DIR,D0,DR,DTOUT,DUOUT,LRAR,LRARC,LRARF,LRARI,LRARNRB,LRARP,LRARST,LRARU,LRARX,Y
+1 DO CLN^LRARU1
+2 QUIT
