LRARWKD ;DALISC/CKA - ARCHIVE WKLD DATA (64.1);2/1/95
;;5.2;LAB SERVICE;**59**;July 31, 1995
S LRART=64.1,LRARFL="" D CHECK^LRARU G:LRARFL=1 EXIT
S LRAR=1 D NEW^LRARU
DATE ;Called from LR ARCHIVE 64.1 option
;Message
W !!,"First enter a date range selection to archive the"
W !,"WKLD DATA file (64.1)."
;Prompt for a range of dates
D DT^DICRW
BEGDT W !!,"**** Date Range Selection ****",! S %DT="AE",%DT(0)="-T",%DT("A")="Beginning DATE: " D ^%DT
I Y<0 D DELETE G:LRARFL BEGDT G EXIT
S LRPBD=Y,LRBD=LRPBD-.0001
ENDDT W ! S %DT="AE",%DT("A")="Ending DATE: " D ^%DT
I Y<0 D DELETE G:LRARFL ENDDT G EXIT
G:Y<LRBD HELP W ! S LRPED=Y,LRED=LRPED+.99
;SAVE SELECTION CRITERIA IN LAB ARCHIVAL ACTIVITY FILE
D SAVESEL^LRARU1
;OPTIONAL PRINT SELECTED ENTRIES
ASKPRT S DIR(0)="Y",DIR("A")="WOULD YOU LIKE TO PRINT SELECTED ENTRIES",DIR("B")="YES" D ^DIR
I $D(DIRUT)!('Y) G COMP
PRT ;EN1^DIP CALL
S L=0,DIC="^LRO(64.1,",BY=".01,.03,.01",FR=","_LRPBD,TO=","_LRPED
D EN1^DIP
COMP ;ARCHIVING ACTION COMPLETED
D COMP^LRARU1
EXIT K BY,DA,DIC,DIR,DIRUT,DTOUT,DUOUT,FR,L,LRAR,LRARC,LRARFL,LRARI,LRART,LRARX,LRBD,LRED,LRPBD,LRPED,TO,Y
D CLN^LRARU1
Q
HELP W "??",!?5,"Ending date must not be on or before beginning date" G DATE
CLEAR ;REMOVE DATA FROM ARCHIVED WKLD DATA FILE
;CHECK LAB ARCHIVAL ACTIVITY FILE
W !!,"This will clear the data from the Archived Wkld Data file."
ASKCLR K DIR S DIR(0)="Y",DIR("A")="ARE YOU SURE YOU WANT TO DO THIS",DIR("B")="YES" D ^DIR K DIR
I $D(DIRUT)!('Y) G EXIT
S LRAR=3,LRART=64.1,LRARC=0 S LRARC=$O(^LAB(95.11,"O",2,LRART,LRARC)) G:LRARC="" ERROR D FILE^LRARU G:'$D(LRARC) EXIT
;CLEARING IN PROGRESS
D MRK^LRARU1
W !!,"I will now CLEAR out the global."
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"
W !!,">>> DONE <<<"
;UPDATE ENTRY IN LAB ARCHIVAL ACTIVITY FILE
S LRAR=3 D UPDATE^LRARU1
D COMP^LRARU1
D CLN^LRARU1
Q
DELETE K DIR S LRARFL="",DIR(0)="Y",DIR("A")="Do you want to delete this archival activity and forget this for now",DIR("B")="YES"
D ^DIR
I $D(DIRUT)!('Y) W !,"You must enter a beginning and ending date." S LRARFL=1 Q
W !!,"Now deleting this archival activity..."
S DIK="^LAB(95.11,",DA=LRARC D ^DIK W !!,">>> DONE <<<"
Q
ERROR W !!,$C(7),"I cannot find an archival activity for file 64.1 with the correct archival status."
G EXIT
Q
;LRARC=LAB ARCHIVAL ACTIVITY INTERNAL FILE #
;LRARFL= OUTSTANDING ARCHIVAL ACTIVITY FLAG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARWKD 2557 printed Nov 22, 2024@17:19:43 Page 2
LRARWKD ;DALISC/CKA - ARCHIVE WKLD DATA (64.1);2/1/95
+1 ;;5.2;LAB SERVICE;**59**;July 31, 1995
+2 SET LRART=64.1
SET LRARFL=""
DO CHECK^LRARU
if LRARFL=1
GOTO EXIT
+3 SET LRAR=1
DO NEW^LRARU
DATE ;Called from LR ARCHIVE 64.1 option
+1 ;Message
+2 WRITE !!,"First enter a date range selection to archive the"
+3 WRITE !,"WKLD DATA file (64.1)."
+4 ;Prompt for a range of dates
+5 DO DT^DICRW
BEGDT WRITE !!,"**** Date Range Selection ****",!
SET %DT="AE"
SET %DT(0)="-T"
SET %DT("A")="Beginning DATE: "
DO ^%DT
+1 IF Y<0
DO DELETE
if LRARFL
GOTO BEGDT
GOTO EXIT
+2 SET LRPBD=Y
SET LRBD=LRPBD-.0001
ENDDT WRITE !
SET %DT="AE"
SET %DT("A")="Ending DATE: "
DO ^%DT
+1 IF Y<0
DO DELETE
if LRARFL
GOTO ENDDT
GOTO EXIT
+2 if Y<LRBD
GOTO HELP
WRITE !
SET LRPED=Y
SET LRED=LRPED+.99
+3 ;SAVE SELECTION CRITERIA IN LAB ARCHIVAL ACTIVITY FILE
+4 DO SAVESEL^LRARU1
+5 ;OPTIONAL PRINT SELECTED ENTRIES
ASKPRT SET DIR(0)="Y"
SET DIR("A")="WOULD YOU LIKE TO PRINT SELECTED ENTRIES"
SET DIR("B")="YES"
DO ^DIR
+1 IF $DATA(DIRUT)!('Y)
GOTO COMP
PRT ;EN1^DIP CALL
+1 SET L=0
SET DIC="^LRO(64.1,"
SET BY=".01,.03,.01"
SET FR=","_LRPBD
SET TO=","_LRPED
+2 DO EN1^DIP
COMP ;ARCHIVING ACTION COMPLETED
+1 DO COMP^LRARU1
EXIT KILL BY,DA,DIC,DIR,DIRUT,DTOUT,DUOUT,FR,L,LRAR,LRARC,LRARFL,LRARI,LRART,LRARX,LRBD,LRED,LRPBD,LRPED,TO,Y
+1 DO CLN^LRARU1
+2 QUIT
HELP WRITE "??",!?5,"Ending date must not be on or before beginning date"
GOTO DATE
CLEAR ;REMOVE DATA FROM ARCHIVED WKLD DATA FILE
+1 ;CHECK LAB ARCHIVAL ACTIVITY FILE
+2 WRITE !!,"This will clear the data from the Archived Wkld Data file."
ASKCLR KILL DIR
SET DIR(0)="Y"
SET DIR("A")="ARE YOU SURE YOU WANT TO DO THIS"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
+1 IF $DATA(DIRUT)!('Y)
GOTO EXIT
+2 SET LRAR=3
SET LRART=64.1
SET LRARC=0
SET LRARC=$ORDER(^LAB(95.11,"O",2,LRART,LRARC))
if LRARC=""
GOTO ERROR
DO FILE^LRARU
if '$DATA(LRARC)
GOTO EXIT
+3 ;CLEARING IN PROGRESS
+4 DO MRK^LRARU1
+5 WRITE !!,"I will now CLEAR out the global."
+6 SET LRARX=""
FOR LRARI=0:0
SET LRARX=$ORDER(^LAR(64.19999,LRARX))
if LRARX=""
QUIT
KILL ^LAR(64.19999,LRARX)
+7 SET ^LAR(64.19999,0)="ARCHIVED WKLD DATA^64.19999"
+8 WRITE !!,">>> DONE <<<"
+9 ;UPDATE ENTRY IN LAB ARCHIVAL ACTIVITY FILE
+10 SET LRAR=3
DO UPDATE^LRARU1
+11 DO COMP^LRARU1
+12 DO CLN^LRARU1
+13 QUIT
DELETE KILL DIR
SET LRARFL=""
SET DIR(0)="Y"
SET DIR("A")="Do you want to delete this archival activity and forget this for now"
SET DIR("B")="YES"
+1 DO ^DIR
+2 IF $DATA(DIRUT)!('Y)
WRITE !,"You must enter a beginning and ending date."
SET LRARFL=1
QUIT
+3 WRITE !!,"Now deleting this archival activity..."
+4 SET DIK="^LAB(95.11,"
SET DA=LRARC
DO ^DIK
WRITE !!,">>> DONE <<<"
+5 QUIT
ERROR WRITE !!,$CHAR(7),"I cannot find an archival activity for file 64.1 with the correct archival status."
+1 GOTO EXIT
+2 QUIT
+3 ;LRARC=LAB ARCHIVAL ACTIVITY INTERNAL FILE #
+4 ;LRARFL= OUTSTANDING ARCHIVAL ACTIVITY FLAG
+5 QUIT
