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