Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRARU

LRARU.m

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