- 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 Jan 18, 2025@03:10:18 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