- 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
