| 1 | LRAR05 ;DAL/HOAK NEW ARCHIVE PURGER ; 12/12/96 10:16 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**111**;Sep 27, 1994
|
|---|
| 3 | INIT ; Building block from...\/
|
|---|
| 4 | ; LRCHIVK SLC/RWF - REMOVE OLD LAB DATA ; 12/14/87 15:46 ;
|
|---|
| 5 | Q
|
|---|
| 6 | EN ;from LRCHIV
|
|---|
| 7 | U IO W @IOF,"START OF PURGE PASS" D STAMP^LRX
|
|---|
| 8 | S LRDFN=0
|
|---|
| 9 | DFN ;
|
|---|
| 10 | S LRDFN=$O(^LAR("Z",LRDFN)) G END:LRDFN="" W "."
|
|---|
| 11 | F LRSS="CH","MI" I $O(^LAR("Z",LRDFN,LRSS,0)) S LRIDT=0,C1=1 D LAB,UPDT
|
|---|
| 12 | S ^LAB(69.9,1,"PURGE LRDFN")=LRDFN G DFN
|
|---|
| 13 | LAB ;
|
|---|
| 14 | S LRIDT=$O(^LAR("Z",LRDFN,LRSS,LRIDT)) Q:LRIDT<1
|
|---|
| 15 | ;
|
|---|
| 16 | IF '$D(^LR(LRDFN,LRSS,LRIDT,0)) W !,"Data not found." G LAB
|
|---|
| 17 | ;
|
|---|
| 18 | ; If data in ^LRA matches ^LR purge
|
|---|
| 19 | ;
|
|---|
| 20 | IF ^LAR("Z",LRDFN,LRSS,LRIDT,0)=^LR(LRDFN,LRSS,LRIDT,0) D G LAB
|
|---|
| 21 | . K ^LAR("Z",LRDFN,LRSS,LRIDT),^LR(LRDFN,LRSS,LRIDT)
|
|---|
| 22 | . S ^LR(LRDFN,"T",P1,0)=P1
|
|---|
| 23 | W !,"^LAR and ^LR don't match, Data not purged.",!
|
|---|
| 24 | W " LRDFN = ",LRDFN_" Sub Script = "_LRSS_" LRIDT = "_LRIDT
|
|---|
| 25 | W !?4,"^LR("_LRDFN_","_LRSS_","_LRIDT_",0) = ",^LR(LRDFN,LRSS,LRIDT,0)
|
|---|
| 26 | W !,"^LAR(""Z"","_LRDFN_","_LRSS_","_LRIDT_",0) = ",^LAR("Z",LRDFN,LRSS,LRIDT,0)
|
|---|
| 27 | K ^LAR("Z",LRDFN,LRSS,LRIDT)
|
|---|
| 28 | G LAB
|
|---|
| 29 | Q
|
|---|
| 30 | UPDT S X=0,LRCNT=0
|
|---|
| 31 | F I=0:0 S X=$O(^LR(LRDFN,LRSS,X)) Q:X<1 S LRCNT=LRCNT+1
|
|---|
| 32 | I LRCNT=0 S ^LR(LRDFN,LRSS,0)=$S(LRSS="CH":"^63.04D",1:"^63.05DA") Q
|
|---|
| 33 | S $P(^LR(LRDFN,LRSS,0),U,4)=LRCNT
|
|---|
| 34 | Q
|
|---|
| 35 | END W !!,"**PURGE PASS DONE ** " D STAMP^LRX Q ;W @IOF G H^XUS
|
|---|
| 36 | Q
|
|---|
| 37 | SET ;
|
|---|
| 38 | Q:$E(IOST,1,2)'="C-"
|
|---|
| 39 | W @IOF D SCRNON S DX=2,DY=2 X IOXY S OK=1 S LRI=0,LRIN=0 K LRTIC
|
|---|
| 40 | Q
|
|---|
| 41 | ;CAN BE USED INSTEAD OF dots TO SHOW USER HOW JOB IS PROCEEDING
|
|---|
| 42 | ;
|
|---|
| 43 | ; LRJT0=4th piece of 0 node of file being searched
|
|---|
| 44 | ;F LRI=1:1:70 S DX=LRI*2+2,DY=6 X IOXY D
|
|---|
| 45 | JOBTIME ;
|
|---|
| 46 | Q:$E(IOST,1,2)'="C-"
|
|---|
| 47 | S OK=1
|
|---|
| 48 | S DX=LRI*2+2,DY=6 X IOXY D
|
|---|
| 49 | . I '$G(LRTIC) S LRTIC=$P((LRJT0/70),".")
|
|---|
| 50 | . Q:(LRI+1)'>LRTIC S LRTIC=LRTIC+$P((LRJT0/70),".") S LRIN=LRIN+1
|
|---|
| 51 | . S DX=2+LRIN,DY=8 X IOXY
|
|---|
| 52 | . W IORVON
|
|---|
| 53 | . W ">"
|
|---|
| 54 | . W IORVOFF
|
|---|
| 55 | . S DX=16,DY=17 X IOXY
|
|---|
| 56 | . W IODHLT,$E((LRIN/LRJT0)*100,1,4),"% of ^LR"
|
|---|
| 57 | . S DX=16,DY=18 X IOXY
|
|---|
| 58 | . W IODHLB,$E((LRIN/LRJT0)*100,1,4),"% of ^LR"
|
|---|
| 59 | . D FLASH
|
|---|
| 60 | I 'OK D SCRNOFF
|
|---|
| 61 | Q
|
|---|
| 62 | SCRNON ;
|
|---|
| 63 | ;D GSET^%ZISS W IOG1
|
|---|
| 64 | D ENS^%ZISS S %ZIS="I"
|
|---|
| 65 | D FLASH
|
|---|
| 66 | Q
|
|---|
| 67 | FLASH ;
|
|---|
| 68 | ;S LRDT7=LRIDT
|
|---|
| 69 | I '$G(LRDT7) S LRDT7=LR(1)
|
|---|
| 70 | S DX=13,DY=20 X IOXY
|
|---|
| 71 | ;W IORVON
|
|---|
| 72 | W IODHLT,$$CJ^XLFSTR($$FMTE^XLFDT(LRDT7,"D"),IOM)
|
|---|
| 73 | S DY=DY+1 X IOXY
|
|---|
| 74 | W IODHLB,$$CJ^XLFSTR($$FMTE^XLFDT(LRDT7,"D"),IOM)
|
|---|
| 75 | ;W IOIND
|
|---|
| 76 | ;W IORVOFF
|
|---|
| 77 | ;S DY=DY-1 X IOXY
|
|---|
| 78 | ;W " "
|
|---|
| 79 | ;S DY=DY+3 X IOXY
|
|---|
| 80 | ;W $G(LRI)
|
|---|
| 81 | Q
|
|---|
| 82 | SCRNOFF ;
|
|---|
| 83 | W IOBOFF
|
|---|
| 84 | D KILL^%ZISS
|
|---|
| 85 | ;W IOG0 D GKILL^%ZISS
|
|---|
| 86 | QUIT
|
|---|
