BLRLUACA.m

BLRLUACA ; IHS/OIT/MKK - IHS LRUPAC A, purge of old data ; [ 05/15/11  7:50 AM ]

 ;;5.2;LR;**1030**;NOV 01, 1997

 ;;

 ;; Purges old data from ^BLRLUPAC global.

 ;;

EP ; EP - Menu of Reports

 NEW LAB60IEN,L60DESC,LOOPER,SPECTYPE,SPECNAME

 NEW HEADER,LINES,MAXLINES,PG,QFLG,HEDONE

 NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE

 NEW DIRTRICK,ENDMSG

 NEW BLRMMENU,BLRVERN

 NEW DATETIME,PURGESTR

 NEW ARR,CNT,COL,DASHER,DTT,EXTDTT,LRAADESC,OUTARRAY

 NEW SELLRAA,SELSTR,SORTVAR,START,STOP,STR,VARIOUS,WIDE,WOT

 ;

 S BLRVERN=$P($P($T(+1),";")," ")

 S (DTT,CNT,COL,WIDE)=0,ARR=1,SELSTR=""

 D SETARRAY^BLRLUAC2

 ;

 D OUTHEAD

 ;

 I $D(WOT)<1 D  Q 0

 . D HEADERDT^BLRGMENU

 . W !,?4,"No Compiled Data exists.",!

 . D PRESSKEY^BLRGMENU(9)

 . S DATETIME=0

 ;

 S DATETIME=-1,ATLEAST1=0

 F  Q:DATETIME>-1  D

 . D HEADERDT^BLRGMENU

 . D ^XBFMK

 . S DIR(0)=SELSTR

 . S DIR("A")="Enter Response (1-"_$O(WOT(""),-1)_")"

 . S ARR=0,CNT=5

 . F  S ARR=$O(VARIOUS(ARR))  Q:ARR=""  D

 .. S DIR("L",CNT)=$G(VARIOUS(ARR))

 .. S CNT=CNT+1

 . S DIR("L",1)="Select one of the Date/Time Compilations below to be purged:"

 . S DIR("L",2)=""

 . S DIR("L",3)="            Compiled          Acc Area                Begin Date     End Date"

 . S DIR("L",4)="         -------------------  "_DASHER_"----------     ----------"

 . S DIR("L")=""

 . D ^DIR

 . ;

 . I +$G(DIRUT) S DATETIME=0  Q

 . S ATLEAST1=ATLEAST1+1

 . ;

 . S DATETIME=+$G(WOT(+$G(Y)))

 . S PURGESTR=$G(VARIOUS(+$G(Y)+1))

 . ;

 . K HEADER(2)

 . S HEADER(2)="Report Selected To Be Purged"

 . D PURGHEAD("The Date/Time Compilation below has been selected to be purged.")

 . D ^XBFMK

 . S DIR(0)="YAO"

 . S DIR("A")="Purge the above compilation? "

 . S DIR("B")="NO"

 . D ^DIR

 . I +$G(Y)'=1 D  Q

 .. W !!,?4,"NO Purge selected.  Routine Ends.",!

 .. D PRESSKEY^BLRGMENU(9)

 . ;

 . K ^BLRLUPAC(DATETIME)

 . K HEADER(2)

 . S HEADER(2)="Report Purged"

 . D PURGHEAD("The Date/Time Compilation below has been purged.")

 . ;

 . D PRESSKEY^BLRGMENU(14)

 ;

 I ATLEAST1<1 D

 . W !!,?4,"No/Invalid Selection.  Routine Ends."

 . D PRESSKEY^BLRGMENU(9)

 ;

 Q

 ;

OUTHEAD ; EP -- Reset HEADER array & Display

 K HEADER

 S HEADER(1)="Lab Accession and Test Counts"

 S HEADER(2)="Report To Be Purged Selection"

 ;

 Q

 ;

PURGHEAD(HEDSTR) ; EP - Purge Header

 D HEADERDT^BLRGMENU

 W !,HEDSTR,!!

 W "            Compiled          Acc Area                Begin Date     End Date",!

 W "         -------------------  "_DASHER_"----------     ----------",!

 W PURGESTR,!

 Q

BLRLUACA  ; IHS/OIT/MKK - IHS LRUPAC A, purge of old data ; [ 05/15/11  7:50 AM ]

 +1       ;;5.2;LR;**1030**;NOV 01, 1997

 +2       ;;

 +3       ;; Purges old data from ^BLRLUPAC global.

 +4       ;;

EP        ; EP - Menu of Reports

 +1        NEW LAB60IEN,L60DESC,LOOPER,SPECTYPE,SPECNAME

 +2        NEW HEADER,LINES,MAXLINES,PG,QFLG,HEDONE

 +3        NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE

 +4        NEW DIRTRICK,ENDMSG

 +5        NEW BLRMMENU,BLRVERN

 +6        NEW DATETIME,PURGESTR

 +7        NEW ARR,CNT,COL,DASHER,DTT,EXTDTT,LRAADESC,OUTARRAY

 +8        NEW SELLRAA,SELSTR,SORTVAR,START,STOP,STR,VARIOUS,WIDE,WOT

 +9       ;

 +10       SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")

 +11       SET (DTT,CNT,COL,WIDE)=0

           SET ARR=1

           SET SELSTR=""

 +12       DO SETARRAY^BLRLUAC2

 +13      ;

 +14       DO OUTHEAD

 +15      ;

 +16       IF $DATA(WOT)<1

               Begin DoDot:1

 +17               DO HEADERDT^BLRGMENU

 +18               WRITE !,?4,"No Compiled Data exists.",!

 +19               DO PRESSKEY^BLRGMENU(9)

 +20               SET DATETIME=0

               End DoDot:1

               QUIT 0

 +21      ;

 +22       SET DATETIME=-1

           SET ATLEAST1=0

 +23       FOR 

               IF DATETIME>-1

                   QUIT 

               Begin DoDot:1

 +24               DO HEADERDT^BLRGMENU

 +25               DO ^XBFMK

 +26               SET DIR(0)=SELSTR

 +27               SET DIR("A")="Enter Response (1-"_$ORDER(WOT(""),-1)_")"

 +28               SET ARR=0

                   SET CNT=5

 +29               FOR 

                       SET ARR=$ORDER(VARIOUS(ARR))

                       IF ARR=""

                           QUIT 

                       Begin DoDot:2

 +30                       SET DIR("L",CNT)=$GET(VARIOUS(ARR))

 +31                       SET CNT=CNT+1

                       End DoDot:2

 +32               SET DIR("L",1)="Select one of the Date/Time Compilations below to be purged:"

 +33               SET DIR("L",2)=""

 +34               SET DIR("L",3)="            Compiled          Acc Area                Begin Date     End Date"

 +35               SET DIR("L",4)="         -------------------  "_DASHER_"----------     ----------"

 +36               SET DIR("L")=""

 +37               DO ^DIR

 +38      ;

 +39               IF +$GET(DIRUT)

                       SET DATETIME=0

                       QUIT 

 +40               SET ATLEAST1=ATLEAST1+1

 +41      ;

 +42               SET DATETIME=+$GET(WOT(+$GET(Y)))

 +43               SET PURGESTR=$GET(VARIOUS(+$GET(Y)+1))

 +44      ;

 +45               KILL HEADER(2)

 +46               SET HEADER(2)="Report Selected To Be Purged"

 +47               DO PURGHEAD("The Date/Time Compilation below has been selected to be purged.")

 +48               DO ^XBFMK

 +49               SET DIR(0)="YAO"

 +50               SET DIR("A")="Purge the above compilation? "

 +51               SET DIR("B")="NO"

 +52               DO ^DIR

 +53               IF +$GET(Y)'=1

                       Begin DoDot:2

 +54                       WRITE !!,?4,"NO Purge selected.  Routine Ends.",!

 +55                       DO PRESSKEY^BLRGMENU(9)

                       End DoDot:2

                       QUIT 

 +56      ;

 +57               KILL ^BLRLUPAC(DATETIME)

 +58               KILL HEADER(2)

 +59               SET HEADER(2)="Report Purged"

 +60               DO PURGHEAD("The Date/Time Compilation below has been purged.")

 +61      ;

 +62               DO PRESSKEY^BLRGMENU(14)

               End DoDot:1

 +63      ;

 +64       IF ATLEAST1<1

               Begin DoDot:1

 +65               WRITE !!,?4,"No/Invalid Selection.  Routine Ends."

 +66               DO PRESSKEY^BLRGMENU(9)

               End DoDot:1

 +67      ;

 +68       QUIT 

 +69      ;

OUTHEAD   ; EP -- Reset HEADER array & Display

 +1        KILL HEADER

 +2        SET HEADER(1)="Lab Accession and Test Counts"

 +3        SET HEADER(2)="Report To Be Purged Selection"

 +4       ;

 +5        QUIT 

 +6       ;

PURGHEAD(HEDSTR) ; EP - Purge Header

 +1        DO HEADERDT^BLRGMENU

 +2        WRITE !,HEDSTR,!!

 +3        WRITE "            Compiled          Acc Area                Begin Date     End Date",!

 +4        WRITE "         -------------------  "_DASHER_"----------     ----------",!

 +5        WRITE PURGESTR,!

 +6        QUIT