| 1 | LRCAP67 ;DALISC/FHS - PURGE 67.9 FILE LMIP PHASE 5
|
|---|
| 2 | ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | D ^LRPARAM I '$P($G(LRLABKY),U,3) W !!,"Sorry you do not have the proper security Key",!! G END
|
|---|
| 5 | W !!?5,"This routine is used to purge data from LAB MONTHLY WORKLOAD file"
|
|---|
| 6 | W !,"after it has been transmitted to the national database. It can also be used to"
|
|---|
| 7 | W !,"clear the file and recompute data found to be erroneous after review.",!!
|
|---|
| 8 | ARCH ;
|
|---|
| 9 | W !?10,"If you intend to archive this data have your Site Manager save"
|
|---|
| 10 | W !,"in the appropriate manner the global, ^LRO(67.9, to desired media "
|
|---|
| 11 | W !,"before deleting any data.",!!
|
|---|
| 12 | W !?10,"Do you want a list of monthly compiled data in the file.",!
|
|---|
| 13 | 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
|
|---|
| 14 | SELDIV ;
|
|---|
| 15 | K DIC S LRINST=$O(^LRO(67.9,0)) I 'LRINST W !!?10,"NO DATA IN THE FILE " G END
|
|---|
| 16 | S DIC="^LRO(67.9,"_LRINST_",1,",DIC(0)="AENMZ" D ^DIC G:Y<1 EN S LRDIV=+Y
|
|---|
| 17 | SELMT ;
|
|---|
| 18 | I '$O(^LRO(67.9,LRINST,1,LRDIV,1,0)) W !!?10,"NO MONTHLY DATA IN THE FILE",! G EN
|
|---|
| 19 | K DA,DR S DIC=DIC_LRDIV_",1," D ^DIC G:Y<1 EN W !! S LRDIC=DIC,(LRDA,DA)=+Y,LRMT=$P(Y,U,2),DA(1)=LRDIV,DA(2)=LRINST,DR=0 D EN^DIQ
|
|---|
| 20 | S DIR(0)="Y",DIR("A")="You wish to purge "_$$FMTE^XLFDT(LRMT)_" data " D ^DIR
|
|---|
| 21 | G END:$D(DUOUT)!($D(DTOUT))!($D(DIRUT)) I Y'=1 G EN
|
|---|
| 22 | W !! S DA=LRDA,DIC=LRDIC,DA(1)=LRDIV,DA(2)=LRINST,DR=0 D EN^DIQ
|
|---|
| 23 | S DIR(0)="Y",DIR("A")="Are you very certain you wish to remove this Data? " D ^DIR G EN:Y'=1
|
|---|
| 24 | W !!?10,"Deleting "_$$FMTE^XLFDT(LRMT)_" DATA ",!
|
|---|
| 25 | S DIK=LRDIC D ^DIK W !!,"DATA DELETED",!! G EN
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | DIS ;
|
|---|
| 29 | K %ZIS,IO("Q") S %ZIS="Q" D ^%ZIS S:POP LREND=1 Q:LREND
|
|---|
| 30 | 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
|
|---|
| 31 | U IO
|
|---|
| 32 | DISDQ ;
|
|---|
| 33 | W:$E(IOST,1,2)="C-" @IOF
|
|---|
| 34 | S (LREND,LRINST)=0 F S LRINST=$O(^LRO(67.9,LRINST)) Q:LRINST<1 D G:$G(LREND) END I '$G(LRDATA) W !!?10,"NO DATA TO PURGE " G END
|
|---|
| 35 | . S LRDIV=0 F S LRDIV=$O(^LRO(67.9,LRINST,1,LRDIV)) Q:LRDIV<1!($G(LREND)) W:$O(^LRO(67.9,LRINST,1,LRDIV,1,0)) !?30,$P(^DIC(4,LRDIV,0),U) D
|
|---|
| 36 | . . S LRAD=0 F S LRAD=$O(^LRO(67.9,LRINST,1,LRDIV,1,LRAD)) Q:LRAD<1!($G(LREND)) D
|
|---|
| 37 | . . .I ($Y+6)>IOSL D:$E(IOST,1,2)="C-" PAUSE Q:$G(LREND) W @IOF,!!?30,$P(^DIC(4,LRDIV,0),U)
|
|---|
| 38 | . . .K DA,DIC,DR S LRDATA=1,DA=LRAD,DA(1)=LRDIV,DA(2)=LRINST,DIC="^LRO(67.9,"_DA(2)_",1,"_DA(1)_",1,",DR=0 D EN^DIQ
|
|---|
| 39 | W !! W:$E(IOST,1,2)="P-" @IOF S:$D(ZTQUEUED) ZTREQ="@" K IO("Q") D ^%ZISC Q
|
|---|
| 40 | END ;
|
|---|
| 41 | K %ZIS,DA,DIC,DIK,DIR,DIRUT,DTOUT,DUOUT,LRAD,LRDA,LRDATA,LRDIC,LREND,LRINST,LRMT,ZTDESC,ZTIO,ZTQUEUED,ZTRTN D ^%ZISC
|
|---|
| 42 | Q
|
|---|
| 43 | PAUSE ;
|
|---|
| 44 | K DIR S DIR(0)="E" D ^DIR
|
|---|
| 45 | S:($D(DTOUT))!($D(DUOUT))!($D(DIRUT)) LREND=1 Q:$G(LREND)
|
|---|
| 46 | Q
|
|---|
