- 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
