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

LRNINES7.m

Go to the documentation of this file. 
  1. LRNINES7 ;DAL/HOAK SEARCH FOR 7 9s ; 10/14/96 16:02
  1.  ;;5.2;LAB SERVICE;**156**;Sep 27, 1994
  1.  ;
  1. INIT ;
  1.  ;
  1.  ;
  1.  ;^LR(582,"CH",9999999,0) = 0^1^2970522.101919^389^72^CH 0522 106^^MONARCH 2
  1. CONTROL ;
  1.  K ^TMP("LR",$J,"7-9s")
  1.  D FINDLR
  1.  S LRTIC=""
  1.  ;
  1.  D FIXALL
  1. END ;
  1.  ;
  1. DONE W !!,"All occurences of 7 9s have been removed and their effects in"
  1.  W !,"your data base have been disarmed.",!
  1.  D ^LRKILL
  1.  QUIT
  1.  ;
  1. TASK ;
  1.  ;-->Task the job to look for 7-9s that were created Today
  1.  ;
  1.  K ^TMP("LR",$J,"7-9s")
  1.  ;
  1.  S LRCOUNT=0
  1.  S LRCNTLR=500
  1.  S LRT70=LRCNTLR,LRIN=0,LRA=1,LRI=1
  1.  I IOST["C-" W @IOF D
  1.  .  S DX=3,DY=10 X IOXY
  1.  .  D JOBTIME
  1.  .  D TITLE^XPDID("SEARCHING ^LR(")
  1.  ;
  1.  S X1=DT,X2=-1 D C^%DTC S LRDT0=X
  1.  S LRDFN=0
  1.  F LRODT=LRDT0,DT D
  1.  .  F  S LRDFN=$O(^LRO(69,LRODT,1,"AA",LRDFN)) Q:+LRDFN'>0  D SET(LRDFN)
  1.  ;
  1.  ;
  1.  D SCRNOFF
  1.  I '$D(TMP("LR",$J,"7-9s")) D
  1.  .  Q:IOST'["C-"
  1.  .  W !!,"Mission debreifing:"
  1.  .  W !,"No problems related to 7-9s have been observed for Yesterday and Today."
  1.  QUIT
  1.  ;
  1. FINDLR ;----------find ALL the 7 nines in ALL OF LR
  1.  ;---> ^LR(0)=LAB DATA^63^464^355
  1.  ;
  1.  S LRCNTLR=$P(^LR(0),U,4)
  1.  S LRT70=LRCNTLR,LRIN=0,LRA=1,LRI=1
  1.  ;
  1.  I IOST["C-" W @IOF D
  1.  .  S DX=3,DY=10 X IOXY
  1.  .  D JOBTIME
  1.  .  D TITLE^XPDID("SEARCHING ^LR(")
  1.  S LRDFN=0,LRCOUNT=0
  1.  F  S LRDFN=$O(^LR(LRDFN)) Q:+LRDFN'>0  D
  1.  .  ;--------check all ^LR(subscripts
  1.  .  D SET(LRDFN)
  1.  S DX=5,DY=15 X IOXY
  1.  W "Found ",LRCOUNT," occurrances of 7 9s in ^LR" H 2
  1.  D SCRNOFF
  1.  QUIT
  1.  ;
  1. SET(LRDFN) ;
  1.  ;
  1.  ;
  1.  I IOST["C-" D MOVE
  1.  F LRSUB="CH","MI" D
  1.  .  I $D(^LR(LRDFN,LRSUB,9999999,0)) D
  1.  ..  S ^TMP("LR",$J,"7-9s",LRDFN,LRSUB)="" S LRCOUNT=LRCOUNT+1
  1.  QUIT
  1.  ;
  1. FIXALL ;
  1.  ;
  1.  ;
  1. COUNT ;
  1.  S LRCOUNT=0
  1.  S LRX6=0
  1.  F  S LRX6=$O(^TMP("LR",$J,"7-9s",LRX6)) Q:+LRX6'>0  S LRCOUNT=LRCOUNT+1
  1.  S LRCNTLR=LRCOUNT
  1.  I IOST["C-" W @IOF D
  1.  .  S DX=3,DY=10 X IOXY
  1.  .  D JOBTIME
  1.  .  D TITLE^XPDID("Fixing ^LR(, ^LRO(68, ^LRO(69, and ^LAC(")
  1.  S LRDFN=0
  1.  F  S LRDFN=$O(^TMP("LR",$J,"7-9s",LRDFN)) Q:+LRDFN'>0  D
  1.  .  S LRSUB=""
  1.  .  F  S LRSUB=$O(^TMP("LR",$J,"7-9s",LRDFN,LRSUB)) Q:LRSUB=""  D
  1.  ..  I IOST["C-" D MOVE
  1.  ..  Q:'$D(^LR(LRDFN,LRSUB,9999999,0))
  1.  ..  S LRNODE=^LR(LRDFN,LRSUB,9999999,0)
  1.  ..  D ACCN(LRNODE)
  1.  I IOST["C-" D MOVE
  1.  QUIT
  1.  ;
  1.  ;
  1. ACCN(LRNODE) ;
  1.  ;-->If LRNODE is not there or it is not an accn we still could
  1.  ;--> LAC( involved
  1.  ;
  1.  I '$D(LRNODE) D CHKLAC QUIT
  1.  ;
  1.  K LRAA,LRAD,LRAN,LRACCN,LRODT,LRSN
  1.  ;
  1.  ;
  1. BAKDOR ;-->Maybe the ^LAC can provide accn.
  1.  ;
  1.  S LRACCN=$P(LRNODE,U,6) ;--CH 0522 106
  1.  S LRAA=$O(^LRO(68,"B",$P(LRACCN," "),0))
  1.  S LRAD=$E($P(LRNODE,U,3),1,3)_$P(LRACCN," ",2) ;-- 297_0522
  1.  S LRAN=$P(LRACCN," ",3) ;--106
  1.  I $G(LRAA)'>0!($L(LRAD)'>4)!($G(LRAN)'>0) S LROK=0 QUIT
  1. LRSN ;
  1.  I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LRSN=$P(^(0),U,5)
  1. LRODT ;
  1.  I $G(LRSN)>0 S LRODT=+$G(^LRO(69,LRAD,1,LRSN,1))
  1.  ;
  1.  ;
  1.  I $G(LRODT)'>0,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LRODT=LRAD
  1.  I $G(LRODT)'>0,$P(LRNODE,U,3)'="" S LRODT=$P(LRNODE,U,3) D
  1.  .  S LRODT1=LRODT
  1.  .  S LRODT=$P(LRODT,".")
  1.  .  I $G(LRODT1)>0 S LRIDT=9999999-LRODT1
  1.  .  D LAC(LRDFN,LRODT1,LRIDT) K LRODT
  1.  Q:'$G(LRODT)
  1.  ;
  1.  ;
  1. LRIDT ;
  1.  ;
  1.  S LRODT1=LRODT
  1.  S LRODT=$P(LRODT,".")
  1.  I $G(LRODT1)>0 S LRIDT=9999999-LRODT1
  1.  ;
  1.  D FIX68
  1.  ;
  1. BYE68 D LAC(LRDFN,LRODT1,LRIDT)
  1.  ;
  1.  QUIT
  1.  ;
  1. LAC(LRDFN,LRODT,LRIDT) ;
  1.  K LRTOE
  1.  ;^LAC("LRAC",34390,1,22,1,1,1,2970702.184153,0)
  1.  ;^LAC("LRAC",582,1,4,1,1,1,0,0) = 0^58-2*^2970522.101919^CH 0522 106^9999999
  1.  ;^LAC("LRAC",582,1,4,1,1,1,0,1,0) = ^64.705^7^7
  1.  ;
  1.  S LRTIC=0
  1.  F  S LRTIC=$O(^LAC("LRAC",LRDFN,1,LRTIC)) Q:+LRTIC'>0  D
  1.  .  S LRTAC=0
  1.  .  F  S LRTAC=$O(^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC)) Q:+LRTAC'>0  D
  1.  ..  Q:'$D(^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC,1,0,0))  S LACNODE=^(0)
  1.  ..  I $P(LACNODE,U)=0 D FIXLAC
  1.  ..  S LRACCN=$P(LACNODE,U,4)
  1.  ..  ;I $G(LRAN)'>0,$D(LRACCN) D BAKDOR
  1.  D:'$G(LRTOE) FIXLR
  1.  Q
  1. FIXLAC ;
  1.  ;^LAC("LRAC",34390,1,22,1,1,1,2970702.184153,0)
  1.  ;                       good girl-> /\
  1.  S LRLONG=$L(LACNODE)
  1.  S LACNODE=$E(LACNODE,2,LRLONG)
  1.  ; ^LAC("LRAC",582,1,4,1,1,1,0,1,7,0) = 20.^L^8
  1.  ;^LAC("LRAC",582,1,4,1,1,1,0,0) = 0^58-2*^2970522.101919^CH 0522 106^9999999-----------------------------/\<----bad girl
  1.  S %Y="^LAC(""LRAC"",LRDFN,1,LRTIC,1,LRTAC,1,LRODT1,"
  1.  S %X="^LAC(""LRAC"",LRDFN,1,LRTIC,1,LRTAC,1,0,"
  1.  D %XY^%RCR
  1.  S $P(^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC,1,LRODT1,0),U)=LRODT1
  1.  S $P(^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC,1,LRODT1,0),U,5)=LRIDT
  1.  K ^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC,1,0)
  1.  ;
  1.  D FIXLR
  1.  S LRTOE=1
  1.  ;^LAC("LRAC",582,1,4,1,1,1,0,1,0) = ^64.705^7^7
  1.  ;^LAC("LRAC",582,1,4,1,1,1,0,1,1,0) = 76.^^2
  1.  ;F  S LRTOE=$
  1.  ;
  1.  Q
  1. CHKLAC ;
  1.  Q:'$D(LRNODE)
  1.  S LRODT=$P(LRNODE,U,3)
  1.  ;
  1.  I '$D(LRODT) S ^TMP("LR",$J,"CANT",LRDFN)="" QUIT
  1.  ;
  1.  S LRIDT=9999999-LRODT S LRODT=$P(LRODT,".")
  1.  D LAC(LRDFN,LRODT,LRIDT)
  1.  Q
  1. FIXLR ;
  1.  ;S ^LR(582,"CH",9999999,0)="0^1^2970522.101919^389^72^CH 0522 106^^MONARCH 24332^58-2*"
  1.  ;
  1.  S %Y="^LR(LRDFN,LRSUB,LRIDT,"
  1.  S %X="^LR(LRDFN,LRSUB,9999999,"
  1.  D %XY^%RCR
  1.  S ^LR(LRDFN,LRSUB,LRIDT,0)=$G(^LR(LRDFN,LRSUB,9999999,0))
  1.  S $P(^LR(LRDFN,LRSUB,LRIDT,0),U)=LRODT1
  1.  K ^LR(LRDFN,LRSUB,9999999)
  1.  Q
  1. FIX68 ;
  1.  ;                          COLL. TIME
  1.  ;^LRO(69,2970522,1,434,1)=2970522.073815^1^1658^C^^^^550
  1.  ;
  1.  Q:$G(LRSN)'>0
  1.  Q:'$D(^LRO(69,LRODT,1,LRSN,1))
  1.  S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)=LRIDT
  1.  S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U)=+^LRO(69,LRODT,1,LRSN,1)
  1.  ;
  1.  Q
  1.  ;
  1. JOBTIME ;
  1.  ;
  1.  Q:IOST'["C-"
  1.  ;
  1.  ;
  1.  K LRALT
  1.  S (LRT70,LRJT0,XPDIDVT)=LRCNTLR,LRIN=0,LRA=1,LRI=1
  1.  I IOST["C-" D INIT^XPDID
  1.  S XPDIDTOT=LRCNTLR
  1.  ;
  1.  ;
  1.  Q:$E(IOST,1,2)'="C-"
  1.  S OK=1
  1.  S DX=1,DY=8 X IOXY
  1.  D SCRNON
  1.  QUIT
  1.  ;
  1. MOVE ;
  1.  Q:IOST'["C-"
  1.  ;
  1.  I LRJT0<80 D ALT QUIT
  1.  Q:$G(LRALT)=1
  1.  S LRECIP=+$P((LRJT0/70),".") I LRECIP<1 S LRECIP=1
  1.  S DX=(2+LRIN)/LRECIP,DY=8 X IOXY D
  1.  . I '$G(LRTIC) S LRTIC=$P((LRJT0/70),".")
  1.  . S LRTIC=LRTIC+LRECIP S LRIN=LRIN+1
  1.  . D UPDATE^XPDID(LRIN)
  1.  . QUIT
  1.  . W IORVON
  1.  . W ">"
  1.  . W IORVOFF
  1.  . S DX=38,DY=10 X IOXY
  1.  . W IOELALL
  1.  . W $P((LRIN/LRJT0)*100,"."),"%"
  1.  ;I 'OK D SCRNOFF
  1.  ;
  1.  ;
  1.  ;
  1.  Q
  1. ALT ;
  1.  Q:IOST'["C-"
  1.  ;
  1.  Q:$G(LRALT)=1
  1.  S (LRT70,LRJT0)=LRCNTLR,LRIN=0,LRA=1,LRI=1
  1.  S LRALT=1
  1.  S LRTJ0=70
  1.  F I=1:1:70 D
  1.  .  S DX=(2+LRIN),DY=8 X IOXY D
  1.  .  S LRIN=LRIN+1
  1.  .  D UPDATE^XPDID(LRIN)
  1.  .  QUIT
  1.  .  W IORVON
  1.  .  W ">"
  1.  .  W IORVOFF
  1.  .  S DX=38,DY=10 X IOXY
  1.  .  W IOELALL
  1.  .  S LRHUN=(LRIN/LRJT0)*100 I LRHUN>100 S LRHUN=100
  1.  .  W $P(LRHUN,"."),"%"
  1.  ;
  1.  Q
  1.  ;
  1. SCRNON ;
  1.  Q:IOST'["C-"
  1.  ;D GSET^%ZISS W IOG1
  1.  D ENS^%ZISS S %ZIS="I"
  1.  D FLASH
  1.  Q
  1. FLASH ;
  1.  Q
  1.  ;S LRDT7=LRIDT
  1.  I '$G(LRDT7) S LRDT7=LR(1)
  1.  S DX=13,DY=20 X IOXY
  1.  ;W IORVON
  1.  W IODHLT,$$CJ^XLFSTR($$FMTE^XLFDT(LRDT7,"D"),IOM)
  1.  S DY=DY+1 X IOXY
  1.  W IODHLB,$$CJ^XLFSTR($$FMTE^XLFDT(LRDT7,"D"),IOM)
  1.  ;W IOIND
  1.  ;W IORVOFF
  1.  ;S DY=DY-1 X IOXY
  1.  ;W "                                                                    "
  1.  ;S DY=DY+3 X IOXY
  1.  ;W $G(LRI)
  1.  Q
  1. SCRNOFF ;
  1.  Q:IOST'["C-"
  1.  ;
  1.  S (LRT70,LRJT0,XPDIDVT)=LRCNTLR,LRIN=0,LRA=1,LRI=1
  1.  D EXIT^XPDID("DONE")
  1.  ;W IOBOFF
  1.  ;D KILL^%ZISS
  1.  ;
  1.  ;
  1.  Q