LRARLMW ; IHS/DIR/AAB - ARCHIVE LAB MONTHLY WORKLOADS (67.9) ; [ 07/22/2002 1:06 PM ]
;;5.2;LR;**1002,1013**;JUL 15, 2002
;;5.2;LAB SERVICE;**59**;July 31, 1995
S LRART=67.9,LRARFL="" D CHECK^LRARU G:LRARFL=1 EXIT
S LRAR=1 D NEW^LRARU
DATE ;Called from LR ARCHIVE 67.9 option
;Message
W !!,"First enter a date range selection to archive the"
W !,"LAB MONTHLY WORKLOADS file (67.9)."
;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-100
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 K DIR
I $D(DIRUT)!('Y) G COMP
PRT ;EN1^DIP CALL
S L=0,DIC="^LRO(67.9,",BY=".01,1,1,.01",FR=","_LRBD,TO=","_LRED
D EN1^DIP
COMP ;ARCHIVING ACTION COMPLETED
D COMP^LRARU1
EXIT K BY,DA,DIC,DIK,DIR,DIRUT,DTOUT,DUOUT,FR,L,LRARF,LRAI,LRAINST,LRANUM,LRAR,LRARC,LRARFL,LRARI,LRARP,LRARST,LRART,LRARU,LRARX,LRBD,LRED,LRPBD,LRPED,TO,Y
D CLN^LRARU1
Q
DELETE K DIR S LRARFL=0,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
HELP W "??",!?5,"Ending date must not be on or before beginning date" G DATE
CLEAR ;REMOVE DATA FROM ARCHIVED LAB MONTHLY WORKLOADS FILE
;CHECK LAB ARCHIVAL ACTIVITY FILE
W !!,"This will clear the data from the Archived Lab Monthly Workloads 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=67.9,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(67.99999,LRARX)) Q:LRARX="" K ^LAR(67.99999,LRARX)
S ^LAR(67.99999,0)="ARCHIVED LAB MONTHLY WORKLOADS^67.99999"
;UPDATE ENTRY IN LAB ARCHIVAL ACTIVITY FILE
S LRAR=3 D UPDATE^LRARU1
D COMP^LRARU1
W !!,">>> DONE <<<"
G EXIT
Q
ERROR W !!,$C(7),"I cannot find an archival activity for file 67.9 that has the correct archival status."
G EXIT
Q
;LRARC=LAB ARCHIVAL ACTIVITY INTERNAL FILE #
;LRARFL= OUTSTANDING ARCHIVAL ACTIVITY FLAG
Q
LRARLMW ; IHS/DIR/AAB - ARCHIVE LAB MONTHLY WORKLOADS (67.9) ; [ 07/22/2002 1:06 PM ]
+1 ;;5.2;LR;**1002,1013**;JUL 15, 2002
+2 ;;5.2;LAB SERVICE;**59**;July 31, 1995
+3 SET LRART=67.9
SET LRARFL=""
DO CHECK^LRARU
IF LRARFL=1
GOTO EXIT
+4 SET LRAR=1
DO NEW^LRARU
DATE ;Called from LR ARCHIVE 67.9 option
+1 ;Message
+2 WRITE !!,"First enter a date range selection to archive the"
+3 WRITE !,"LAB MONTHLY WORKLOADS file (67.9)."
+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-100
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
KILL DIR
+1 IF $DATA(DIRUT)!('Y)
GOTO COMP
PRT ;EN1^DIP CALL
+1 SET L=0
SET DIC="^LRO(67.9,"
SET BY=".01,1,1,.01"
SET FR=","_LRBD
SET TO=","_LRED
+2 DO EN1^DIP
COMP ;ARCHIVING ACTION COMPLETED
+1 DO COMP^LRARU1
EXIT KILL BY,DA,DIC,DIK,DIR,DIRUT,DTOUT,DUOUT,FR,L,LRARF,LRAI,LRAINST,LRANUM,LRAR,LRARC,LRARFL,LRARI,LRARP,LRARST,LRART,LRARU,LRARX,LRBD,LRED,LRPBD,LRPED,TO,Y
+1 DO CLN^LRARU1
+2 QUIT
DELETE KILL DIR
SET LRARFL=0
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
HELP WRITE "??",!?5,"Ending date must not be on or before beginning date"
GOTO DATE
CLEAR ;REMOVE DATA FROM ARCHIVED LAB MONTHLY WORKLOADS FILE
+1 ;CHECK LAB ARCHIVAL ACTIVITY FILE
+2 WRITE !!,"This will clear the data from the Archived Lab Monthly Workloads 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=67.9
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(67.99999,LRARX))
IF LRARX=""
QUIT
KILL ^LAR(67.99999,LRARX)
+7 SET ^LAR(67.99999,0)="ARCHIVED LAB MONTHLY WORKLOADS^67.99999"
+8 ;UPDATE ENTRY IN LAB ARCHIVAL ACTIVITY FILE
+9 SET LRAR=3
DO UPDATE^LRARU1
+10 DO COMP^LRARU1
+11 WRITE !!,">>> DONE <<<"
+12 GOTO EXIT
+13 QUIT
ERROR WRITE !!,$CHAR(7),"I cannot find an archival activity for file 67.9 that has the correct archival status."
+1 GOTO EXIT
+2 QUIT
+3 ;LRARC=LAB ARCHIVAL ACTIVITY INTERNAL FILE #
+4 ;LRARFL= OUTSTANDING ARCHIVAL ACTIVITY FLAG
+5 QUIT
