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