Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRAR03

LRAR03.m

Go to the documentation of this file.
  1. LRAR03 ;DAL/HOAK NEW ARCHIVE PURGERSET ; 12/12/96 10:16 ;
  1. ;;5.2;LAB SERVICE;**111**;Sep 27, 1994
  1. INIT ; Building block from...\/
  1. ; LRCHIVK SLC/RWF - REMOVE OLD LAB DATA ; 12/14/87 15:46 ;
  1. Q
  1. EN ;from LRCHIV
  1. U IO W @IOF,"START OF PURGE PASS" D STAMP^LRX
  1. S LRDFN=0
  1. DFN ;
  1. S LRDFN=$O(^LAR("Z",LRDFN)) G END:LRDFN="" W "."
  1. F LRSS="CH","MI" I $O(^LAR("Z",LRDFN,LRSS,0)) S LRIDT=0,C1=1 D LAB,UPDT
  1. S ^LAB(69.9,1,"PURGE LRDFN")=LRDFN G DFN
  1. LAB ;
  1. S LRIDT=$O(^LAR("Z",LRDFN,LRSS,LRIDT)) Q:LRIDT<1
  1. ;
  1. IF '$D(^LR(LRDFN,LRSS,LRIDT,0)) W !,"Data not found." G LAB
  1. ;
  1. ; If data in ^LRA matches ^LR purge
  1. ;
  1. IF ^LAR("Z",LRDFN,LRSS,LRIDT,0)=^LR(LRDFN,LRSS,LRIDT,0) D G LAB
  1. . K ^LAR("Z",LRDFN,LRSS,LRIDT),^LR(LRDFN,LRSS,LRIDT)
  1. . S ^LR(LRDFN,"T",P1,0)=P1
  1. W !,"^LAR and ^LR don't match, Data not purged.",!
  1. W " LRDFN = ",LRDFN_" Sub Script = "_LRSS_" LRIDT = "_LRIDT
  1. W !?4,"^LR("_LRDFN_","_LRSS_","_LRIDT_",0) = ",^LR(LRDFN,LRSS,LRIDT,0)
  1. W !,"^LAR(""Z"","_LRDFN_","_LRSS_","_LRIDT_",0) = ",^LAR("Z",LRDFN,LRSS,LRIDT,0)
  1. K ^LAR("Z",LRDFN,LRSS,LRIDT)
  1. G LAB
  1. Q
  1. UPDT S X=0,LRCNT=0
  1. F I=0:0 S X=$O(^LR(LRDFN,LRSS,X)) Q:X<1 S LRCNT=LRCNT+1
  1. I LRCNT=0 S ^LR(LRDFN,LRSS,0)=$S(LRSS="CH":"^63.04D",1:"^63.05DA") Q
  1. S $P(^LR(LRDFN,LRSS,0),U,4)=LRCNT
  1. Q
  1. END W !!,"**PURGE PASS DONE ** " D STAMP^LRX Q ;W @IOF G H^XUS
  1. Q
  1. SET ;
  1. Q
  1. ;CAN BE USED INSTEAD OF dots TO SHOW USER HOW JOB IS PROCEEDING
  1. ;
  1. ; LRJT0=4th piece of 0 node of file being searched
  1. ;F LRI=1:1:70 S DX=LRI*2+2,DY=6 X IOXY D
  1. JOBTIME ;
  1. ;
  1. Q:$E(IOST,1,2)'="C-"
  1. S OK=1
  1. S DX=LRI*2+2,DY=6 X IOXY D
  1. . I '$G(LRTIC) S LRTIC=$P((LRJT0/70),".")
  1. . Q:(LRI+1)'>LRTIC S LRTIC=LRTIC+$P((LRJT0/70),".") S LRIN=LRIN+1
  1. . S DX=2+LRIN,DY=8 X IOXY
  1. . W IORVON
  1. . W ">"
  1. . W IORVOFF
  1. . S DX=16,DY=17 X IOXY
  1. . W IODHLT,$E((LRIN/LRJT0)*100,1,4),"% of ^LR"
  1. . S DX=16,DY=18 X IOXY
  1. . W IODHLB,$E((LRIN/LRJT0)*100,1,4),"% of ^LR"
  1. . D FLASH
  1. I 'OK D SCRNOFF
  1. Q
  1. SCRNON ;
  1. QUIT
  1. FLASH ;
  1. QUIT
  1. SCRNOFF ;
  1. QUIT