source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAR05.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1LRAR05 ;DAL/HOAK NEW ARCHIVE PURGER ; 12/12/96 10:16 ;
2 ;;5.2;LAB SERVICE;**111**;Sep 27, 1994
3INIT ; Building block from...\/
4 ; LRCHIVK SLC/RWF - REMOVE OLD LAB DATA ; 12/14/87 15:46 ;
5 Q
6EN ;from LRCHIV
7 U IO W @IOF,"START OF PURGE PASS" D STAMP^LRX
8 S LRDFN=0
9DFN ;
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
13LAB ;
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
30UPDT 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
35END W !!,"**PURGE PASS DONE ** " D STAMP^LRX Q ;W @IOF G H^XUS
36 Q
37SET ;
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
45JOBTIME ;
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
62SCRNON ;
63 ;D GSET^%ZISS W IOG1
64 D ENS^%ZISS S %ZIS="I"
65 D FLASH
66 Q
67FLASH ;
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
82SCRNOFF ;
83 W IOBOFF
84 D KILL^%ZISS
85 ;W IOG0 D GKILL^%ZISS
86 QUIT
Note: See TracBrowser for help on using the repository browser.