LRARU1 ;DALISC/CKA - LAB ARCHIVING MISC. CONT.;4/19/95
;;5.2;LAB SERVICE;**59,162**;Sep 27, 1994
UPDATE ;UPDATE LAB ARCHIVAL ACTIVITY FILE
;CALLED FROM LRARWKD,LRARWKD1,LRARLMW,LRARLMW1,LRARBI,LRARBI1
;LRAR=ARCHIVING STATUS
I LRAR=2 S DR="9////"_DT_$S($D(^VA(200)):";5////"_DUZ,1:"")
I LRAR=90 S DR="10////"_DT_$S($D(^VA(200)):";8////"_DUZ,1:"")
S DA=LRARC,DIE="^LAB(95.11,"
I LRAR=2!(LRAR=90) S DR=DR_";7////"_LRAR
E S DR="7////"_LRAR
D ^DIE
Q
COMP ;ARCHIVING ACTION COMPLETED
;CALLED FROM LRARWKD,LRARWKD1,LRARLMW,LRARLMW1,LRARBI,LRARBI1
S DA=LRARC,DIE="^LAB(95.11,",DR="12////@;13///@;14////@;18////@"
D ^DIE
K DA,DIE,DR Q
SAVESEL ;SAVE SELECTION CRITERIA IN LAB ARCHIVAL ACTIVITY FILE
;CALLED FROM LRARWKD,LRARLMW
S DA=LRARC,DIE="^LAB(95.11,",X=""
S X=X_"19////"_LRPBD_";20////"_LRPED
S DR=X D ^DIE
K DA,DIE,DR,X Q
MRK ;SET FIELDS TO LOCK OUT OTHER USERS DURING ARCHIVING ACTIVITY
D NOW^%DTC S DIE="^LAB(95.11,",DA=LRARC,DR="12////"_LRAR_";13////"_%_$S($D(^VA(200)):";14////"_DUZ,1:"")
D ^DIE
Q
TASK ;SET ARCHIVE TASK NUMBER FIELD
S DR="18////"_ZTSK,DIE="^LAB(95.11,",DA=LRARC
D ^DIE
Q
WRITE ;WRITE DATA TO OFF-LINE MEDIA
;called by LRAR WRITE MEDIA options
W !!,"The site manager should determine the method of data storage of the"
I LRART=64.1 W !,"Archived Wkld Data File 64.19999"
I LRART=65 W !,"Archived Blood Inventory File 65.9999"
I LRART=67.9 W !,"Archived Lab Monthly Workloads 67.99999"
S LRAR=100,LRARC=0,LRARC=$O(^LAB(95.11,"O",2,LRART,LRARC)) D:LRARC=""
. W !!,$C(7),"I cannot find an archival activity for this file in the archived status."
. S LRARC=0,LRARC=$O(^LAB(95.11,"O",1,LRART,LRARC)) D:LRARC=""
.. W !!,$C(7),"I cannot find an archival activity for this file in the selected status either."
G:LRARC="" EXIT D FILE^LRARU G:'$D(LRARC) EXIT
;CHECK STATUS OF ARCHIVING TASK
S ZTSK=$P(^LAB(95.11,LRARC,2),U,2)
I ZTSK'="" D STAT^%ZTLOAD D G EXIT
. I ZTSK(0)=1,ZTSK(1)=3 D
.. S LRARFL1=1 D DEV^LRARU
. I ZTSK(1)=1!(ZTSK(1)=2) W !,ZTSK," IS ",ZTSK(2) D
.. W !!,$C(7),"The archiving task must finish before you write data to off-line media!"
. I ZTSK(1)=5 W !!,$C(7),"Please check for errors. The archiving task abnormally ended!"
I ZTSK="" D DEV^LRARU
EXIT K DA,DIC,DIE,DIR,DR,DTOUT,DUOUT,LRAR,LRARC,LRARFL1,LRART
D CLN
Q
CLN K %DT,%ZIS,BY,C,D0,DA,DD,DHD,DIAXF,DIAXGR,DIAXSCR,DIAXST,DIAXT,DIC,DIE,DIK,DINUM,DIQ,DIR,DIRUT
K DIWF,DIWL,DIWR,DLAYGO,DO,DR,DTOUT,DUOUT,END,ERR,FLDS,FR,L,LRADATE,LRADIV,LRADIVN,LRAI,LRAIEN,LRAIFN
K LRAINST,LRAJ,LRAK,LRANUM,LRAR,LRARC,LRARCEX,LRARCX,LRARF,LRARFL,LRARFL1,LRARI,LRARID,LRARN,LRARNRB,LRARP
K LRARST,LRART,LRARU,LRARX,LRBD,LRDAT,LRED,LRID,LRIFN,LRINST,LRPBD,LRPED,LRSCR,PAGE,POP,TO,X,X1,X2,Y,Z,ZTDESC
K ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARU1 2808 printed Dec 13, 2024@02:09:36 Page 2
LRARU1 ;DALISC/CKA - LAB ARCHIVING MISC. CONT.;4/19/95
+1 ;;5.2;LAB SERVICE;**59,162**;Sep 27, 1994
UPDATE ;UPDATE LAB ARCHIVAL ACTIVITY FILE
+1 ;CALLED FROM LRARWKD,LRARWKD1,LRARLMW,LRARLMW1,LRARBI,LRARBI1
+2 ;LRAR=ARCHIVING STATUS
+3 IF LRAR=2
SET DR="9////"_DT_$SELECT($DATA(^VA(200)):";5////"_DUZ,1:"")
+4 IF LRAR=90
SET DR="10////"_DT_$SELECT($DATA(^VA(200)):";8////"_DUZ,1:"")
+5 SET DA=LRARC
SET DIE="^LAB(95.11,"
+6 IF LRAR=2!(LRAR=90)
SET DR=DR_";7////"_LRAR
+7 IF '$TEST
SET DR="7////"_LRAR
+8 DO ^DIE
+9 QUIT
COMP ;ARCHIVING ACTION COMPLETED
+1 ;CALLED FROM LRARWKD,LRARWKD1,LRARLMW,LRARLMW1,LRARBI,LRARBI1
+2 SET DA=LRARC
SET DIE="^LAB(95.11,"
SET DR="12////@;13///@;14////@;18////@"
+3 DO ^DIE
+4 KILL DA,DIE,DR
QUIT
SAVESEL ;SAVE SELECTION CRITERIA IN LAB ARCHIVAL ACTIVITY FILE
+1 ;CALLED FROM LRARWKD,LRARLMW
+2 SET DA=LRARC
SET DIE="^LAB(95.11,"
SET X=""
+3 SET X=X_"19////"_LRPBD_";20////"_LRPED
+4 SET DR=X
DO ^DIE
+5 KILL DA,DIE,DR,X
QUIT
MRK ;SET FIELDS TO LOCK OUT OTHER USERS DURING ARCHIVING ACTIVITY
+1 DO NOW^%DTC
SET DIE="^LAB(95.11,"
SET DA=LRARC
SET DR="12////"_LRAR_";13////"_%_$SELECT($DATA(^VA(200)):";14////"_DUZ,1:"")
+2 DO ^DIE
+3 QUIT
TASK ;SET ARCHIVE TASK NUMBER FIELD
+1 SET DR="18////"_ZTSK
SET DIE="^LAB(95.11,"
SET DA=LRARC
+2 DO ^DIE
+3 QUIT
WRITE ;WRITE DATA TO OFF-LINE MEDIA
+1 ;called by LRAR WRITE MEDIA options
+2 WRITE !!,"The site manager should determine the method of data storage of the"
+3 IF LRART=64.1
WRITE !,"Archived Wkld Data File 64.19999"
+4 IF LRART=65
WRITE !,"Archived Blood Inventory File 65.9999"
+5 IF LRART=67.9
WRITE !,"Archived Lab Monthly Workloads 67.99999"
+6 SET LRAR=100
SET LRARC=0
SET LRARC=$ORDER(^LAB(95.11,"O",2,LRART,LRARC))
if LRARC=""
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"I cannot find an archival activity for this file in the archived status."
+8 SET LRARC=0
SET LRARC=$ORDER(^LAB(95.11,"O",1,LRART,LRARC))
if LRARC=""
Begin DoDot:2
+9 WRITE !!,$CHAR(7),"I cannot find an archival activity for this file in the selected status either."
End DoDot:2
End DoDot:1
+10 if LRARC=""
GOTO EXIT
DO FILE^LRARU
if '$DATA(LRARC)
GOTO EXIT
+11 ;CHECK STATUS OF ARCHIVING TASK
+12 SET ZTSK=$PIECE(^LAB(95.11,LRARC,2),U,2)
+13 IF ZTSK'=""
DO STAT^%ZTLOAD
Begin DoDot:1
+14 IF ZTSK(0)=1
IF ZTSK(1)=3
Begin DoDot:2
+15 SET LRARFL1=1
DO DEV^LRARU
End DoDot:2
+16 IF ZTSK(1)=1!(ZTSK(1)=2)
WRITE !,ZTSK," IS ",ZTSK(2)
Begin DoDot:2
+17 WRITE !!,$CHAR(7),"The archiving task must finish before you write data to off-line media!"
End DoDot:2
+18 IF ZTSK(1)=5
WRITE !!,$CHAR(7),"Please check for errors. The archiving task abnormally ended!"
End DoDot:1
GOTO EXIT
+19 IF ZTSK=""
DO DEV^LRARU
EXIT KILL DA,DIC,DIE,DIR,DR,DTOUT,DUOUT,LRAR,LRARC,LRARFL1,LRART
+1 DO CLN
+2 QUIT
CLN KILL %DT,%ZIS,BY,C,D0,DA,DD,DHD,DIAXF,DIAXGR,DIAXSCR,DIAXST,DIAXT,DIC,DIE,DIK,DINUM,DIQ,DIR,DIRUT
+1 KILL DIWF,DIWL,DIWR,DLAYGO,DO,DR,DTOUT,DUOUT,END,ERR,FLDS,FR,L,LRADATE,LRADIV,LRADIVN,LRAI,LRAIEN,LRAIFN
+2 KILL LRAINST,LRAJ,LRAK,LRANUM,LRAR,LRARC,LRARCEX,LRARCX,LRARF,LRARFL,LRARFL1,LRARI,LRARID,LRARN,LRARNRB,LRARP
+3 KILL LRARST,LRART,LRARU,LRARX,LRBD,LRDAT,LRED,LRID,LRIFN,LRINST,LRPBD,LRPED,LRSCR,PAGE,POP,TO,X,X1,X2,Y,Z,ZTDESC
+4 KILL ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+5 QUIT
