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