LRARWKD.m

LRARWKD ; IHS/DIR/AAB - ARCHIVE WKLD DATA (64.1) ;  [ 07/22/2002  1:09 PM ]

 ;;5.2;LR;**1002,1013**;JUL 15, 2002

 ;;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

LRARWKD   ; IHS/DIR/AAB - ARCHIVE WKLD DATA (64.1) ;  [ 07/22/2002  1:09 PM ]

 +1       ;;5.2;LR;**1002,1013**;JUL 15, 2002

 +2       ;;5.2;LAB SERVICE;**59**;July 31, 1995

 +3        SET LRART=64.1

           SET LRARFL=""

           DO CHECK^LRARU

           IF LRARFL=1

               GOTO EXIT

 +4        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