- LRCAP64 ; IHS/DIR/AAB - PURGE 64.1 FILE LMIP PHASE 6 ;
- ;;5.2;LR;**1006**;SEP 01, 1998
- ;
- ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
- EN ;
- D ^LRPARAM I '$P($G(LRLABKY),U,3) W !!,"Sorry you do not have the proper security Key",!! G END
- W !!?5,"This option is used to purge data from WORKLOAD [WKLD] DATA file"
- W !,"after is has been transmitted to the national database."
- ARCH ;
- W !!?10,"If you intend to archive this data, you should FIRST use Fileman"
- W !,"option TRANSFER FILE ENTRIES to move the data from the WORKLOAD [WKLD] DATA "
- W !,"file (64.1) to the ARCHIVE WORKLAD [WKLD] DATA file (64.19999)"
- W !!,"MAKE SURE THE DATA IS NOT PURGED AFTER TRANSFER WHEN USING THE"
- W !,"FILEMAN TRANSFER OPTION",!
- W !!?5,"Then copy this global [^LRO(64.19999,] to your long term storage media"
- W !,"After coping the ^LRO(64.19999) global, FILEMAN can be used to delete"
- W !,"all of the data from that file [^LRO(64.19999)]."
- W !!,"After the global has been copied, proceed with this step",!!
- LRDIV ;
- K DIC S LRINST=$O(^LRO(67.9,0)) I 'LRINST W !!?10,"NO DATA IN THE FILE " G END
- S DIC="^LRO(64.1,",DIC(0)="AENMZ" D ^DIC G:Y<1 END S LRDIV=+Y
- W !?10,"Do you want a list of months in the file.",!
- S LREND=0 K DIR S DIR(0)="Y" D ^DIR G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT)) END D:Y DIS G:$G(LREND) END
- SELDIV ;
- SELMT ;
- I '$O(^LRO(64.1,LRDIV,1,0)) W !!?10,"NO MONTHLY DATA IN THE FILE",! G EN
- K %DT S %DT="EAP" D ^%DT G EN:Y<1 S LRMT=$E(Y,1,5)_"00" I LRMT'<($E(DT,1,5)_"00") W !!?7,"YOU CAN ONLY DELETE PAST MONTH'S DATA ",$C(7) G SELMT
- I '$O(^LRO(64.1,LRDIV,1,LRMT)) W !!?10,"DO DATA FOR "_$$FMTE^XLFDT(LRMT) G SELMT
- ;
- W ! S DIR(0)="Y",DIR("A")="You wish to purge "_$$FMTE^XLFDT(LRMT)_" data " D ^DIR
- G END:$D(DUOUT)!($D(DTOUT))!($D(DIRUT)) I Y'=1 G EN
- W ! S DIR(0)="Y",DIR("A")="Are you very certain you wish to remove this Data " D ^DIR G EN:Y'=1
- W !!?10,"Deleting "_$$FMTE^XLFDT(LRMT)_" DATA ",!
- S DIK="^LRO(64.1,"_LRDIV_",1,",LRDA=LRMT,DA(1)=LRDIV,DA(2)=64.1 D
- . W ! F S LRDA=$O(^LRO(64.1,LRDIV,1,LRDA)) Q:$E(LRDA,1,5)'=$E(LRMT,1,5) S DA=LRDA I '$P($G(^(LRDA,0)),U,2) W !,$$FMTE^XLFDT(LRDA)," Not reported NOT DELETED",$C(7) Q
- . W "." D ^DIK
- . Q
- W !!,"Data for "_$$FMTE^XLFDT(LRMT)_" deleted " G EN
- Q
- DIS ;
- K %ZIS,IO("Q") S %ZIS="Q" D ^%ZIS S:POP LREND=1 Q:LREND
- I $D(IO("Q")) S ZTRTN="DISDQ^LRCAP67",ZTIO=ION,ZTDESC="Print list of Lab Monthly compiled data" D ^%ZTLOAD S LREND=1 K IO("Q") D ^%ZISC Q
- U IO
- DISDQ ;
- W:$E(IOST,1,2)="C-" @IOF W !!?20,"List of Months which have data to be purged",!!
- W ! S (LREND,LRMT)=0 F S LRMT=$O(^LRO(64.1,LRDIV,1,LRMT)) Q:LRMT<1!($E(LRMT,1,5)=$E(DT,1,5)) D G:$G(LREND) END I '$G(LRDATA) W !!?10,"NO DATA TO PURGE " G END
- . I ($Y+6)>IOSL D:$E(IOST,1,2)="C-" PAUSE Q:$G(LREND)
- . S LRDATA=1,LRMT=$E(LRMT,1,5)_"00" W $$FMTE^XLFDT(LRMT) S LRMT=LRMT+100 W ?($X+20) W:$X>(IOM-12) !
- W !! W:$E(IOST,1,2)="P-" @IOF S:$D(ZTQUEUED) ZTREQ="@" K IO("Q") D ^%ZISC Q
- END ;
- K %ZIS,DA,DIC,DIK,DIR,DIRUT,DTOUT,DUOUT,LRAD,LRDA,LRDATA,LRDIC,LRDIV,LREND,LRINST,LRMT,ZTDESC,ZTIO,ZTQUEUED,ZTRTN D ^%ZISC
- Q
- PAUSE ;
- K DIR S DIR(0)="E" D ^DIR
- S:($D(DTOUT))!($D(DUOUT))!($D(DIRUT)) LREND=1 Q:$G(LREND)
- Q
- LRCAP64 ; IHS/DIR/AAB - PURGE 64.1 FILE LMIP PHASE 6 ;
- +1 ;;5.2;LR;**1006**;SEP 01, 1998
- +2 ;
- +3 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
- EN ;
- +1 DO ^LRPARAM
- IF '$PIECE($GET(LRLABKY),U,3)
- WRITE !!,"Sorry you do not have the proper security Key",!!
- GOTO END
- +2 WRITE !!?5,"This option is used to purge data from WORKLOAD [WKLD] DATA file"
- +3 WRITE !,"after is has been transmitted to the national database."
- ARCH ;
- +1 WRITE !!?10,"If you intend to archive this data, you should FIRST use Fileman"
- +2 WRITE !,"option TRANSFER FILE ENTRIES to move the data from the WORKLOAD [WKLD] DATA "
- +3 WRITE !,"file (64.1) to the ARCHIVE WORKLAD [WKLD] DATA file (64.19999)"
- +4 WRITE !!,"MAKE SURE THE DATA IS NOT PURGED AFTER TRANSFER WHEN USING THE"
- +5 WRITE !,"FILEMAN TRANSFER OPTION",!
- +6 WRITE !!?5,"Then copy this global [^LRO(64.19999,] to your long term storage media"
- +7 WRITE !,"After coping the ^LRO(64.19999) global, FILEMAN can be used to delete"
- +8 WRITE !,"all of the data from that file [^LRO(64.19999)]."
- +9 WRITE !!,"After the global has been copied, proceed with this step",!!
- LRDIV ;
- +1 KILL DIC
- SET LRINST=$ORDER(^LRO(67.9,0))
- IF 'LRINST
- WRITE !!?10,"NO DATA IN THE FILE "
- GOTO END
- +2 SET DIC="^LRO(64.1,"
- SET DIC(0)="AENMZ"
- DO ^DIC
- IF Y<1
- GOTO END
- SET LRDIV=+Y
- +3 WRITE !?10,"Do you want a list of months in the file.",!
- +4 SET LREND=0
- KILL DIR
- SET DIR(0)="Y"
- DO ^DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
- GOTO END
- IF Y
- DO DIS
- IF $GET(LREND)
- GOTO END
- SELDIV ;
- SELMT ;
- +1 IF '$ORDER(^LRO(64.1,LRDIV,1,0))
- WRITE !!?10,"NO MONTHLY DATA IN THE FILE",!
- GOTO EN
- +2 KILL %DT
- SET %DT="EAP"
- DO ^%DT
- IF Y<1
- GOTO EN
- SET LRMT=$EXTRACT(Y,1,5)_"00"
- IF LRMT'<($EXTRACT(DT,1,5)_"00")
- WRITE !!?7,"YOU CAN ONLY DELETE PAST MONTH'S DATA ",$CHAR(7)
- GOTO SELMT
- +3 IF '$ORDER(^LRO(64.1,LRDIV,1,LRMT))
- WRITE !!?10,"DO DATA FOR "_$$FMTE^XLFDT(LRMT)
- GOTO SELMT
- +4 ;
- +5 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="You wish to purge "_$$FMTE^XLFDT(LRMT)_" data "
- DO ^DIR
- +6 IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIRUT))
- GOTO END
- IF Y'=1
- GOTO EN
- +7 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Are you very certain you wish to remove this Data "
- DO ^DIR
- IF Y'=1
- GOTO EN
- +8 WRITE !!?10,"Deleting "_$$FMTE^XLFDT(LRMT)_" DATA ",!
- +9 SET DIK="^LRO(64.1,"_LRDIV_",1,"
- SET LRDA=LRMT
- SET DA(1)=LRDIV
- SET DA(2)=64.1
- Begin DoDot:1
- +10 WRITE !
- FOR
- SET LRDA=$ORDER(^LRO(64.1,LRDIV,1,LRDA))
- IF $EXTRACT(LRDA,1,5)'=$EXTRACT(LRMT,1,5)
- QUIT
- SET DA=LRDA
- IF '$PIECE($GET(^(LRDA,0)),U,2)
- WRITE !,$$FMTE^XLFDT(LRDA)," Not reported NOT DELETED",$CHAR(7)
- QUIT
- +11 WRITE "."
- DO ^DIK
- +12 QUIT
- End DoDot:1
- +13 WRITE !!,"Data for "_$$FMTE^XLFDT(LRMT)_" deleted "
- GOTO EN
- +14 QUIT
- DIS ;
- +1 KILL %ZIS,IO("Q")
- SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- SET LREND=1
- IF LREND
- QUIT
- +2 IF $DATA(IO("Q"))
- SET ZTRTN="DISDQ^LRCAP67"
- SET ZTIO=ION
- SET ZTDESC="Print list of Lab Monthly compiled data"
- DO ^%ZTLOAD
- SET LREND=1
- KILL IO("Q")
- DO ^%ZISC
- QUIT
- +3 USE IO
- DISDQ ;
- +1 IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- WRITE !!?20,"List of Months which have data to be purged",!!
- +2 WRITE !
- SET (LREND,LRMT)=0
- FOR
- SET LRMT=$ORDER(^LRO(64.1,LRDIV,1,LRMT))
- IF LRMT<1!($EXTRACT(LRMT,1,5)=$EXTRACT(DT,1,5))
- QUIT
- Begin DoDot:1
- +3 IF ($Y+6)>IOSL
- IF $EXTRACT(IOST,1,2)="C-"
- DO PAUSE
- IF $GET(LREND)
- QUIT
- +4 SET LRDATA=1
- SET LRMT=$EXTRACT(LRMT,1,5)_"00"
- WRITE $$FMTE^XLFDT(LRMT)
- SET LRMT=LRMT+100
- WRITE ?($X+20)
- IF $X>(IOM-12)
- WRITE !
- End DoDot:1
- IF $GET(LREND)
- GOTO END
- IF '$GET(LRDATA)
- WRITE !!?10,"NO DATA TO PURGE "
- GOTO END
- +5 WRITE !!
- IF $EXTRACT(IOST,1,2)="P-"
- WRITE @IOF
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL IO("Q")
- DO ^%ZISC
- QUIT
- END ;
- +1 KILL %ZIS,DA,DIC,DIK,DIR,DIRUT,DTOUT,DUOUT,LRAD,LRDA,LRDATA,LRDIC,LRDIV,LREND,LRINST,LRMT,ZTDESC,ZTIO,ZTQUEUED,ZTRTN
- DO ^%ZISC
- +2 QUIT
- PAUSE ;
- +1 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- +2 IF ($DATA(DTOUT))!($DATA(DUOUT))!($DATA(DIRUT))
- SET LREND=1
- IF $GET(LREND)
- QUIT
- +3 QUIT
