56 lines
3.6 KiB
Mathematica
56 lines
3.6 KiB
Mathematica
LRLLS2 ;SLC/RWF/MILW/JMC- LOAD LIST FIX UP ;2/5/91 14:40 ;
|
|
;;5.2;LAB SERVICE;**116**;Sep 27, 1994
|
|
;MILW/JMC 4/16/93 Commented out line "DR2", inserted line at "DR2+1", prevent tests from being deleted fro accession file if control.
|
|
SETONE ;from LRLLS
|
|
S ^LRO(68.2,LRINST,1,LRTRAY,0)=LRTRAY_U_DT_U_DUZ_U_LRAA
|
|
S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0)=LRAA_U_LRAD_U_LRAN_U_LRWPROF
|
|
S $P(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0),U,5)=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)):+^(0),1:0)
|
|
F LRIX=0:0 S LRIX=$O(^TMP("LR",$J,"T",LRIX)) Q:LRIX="" S LRTX=^(LRIX) D MV2
|
|
Q
|
|
MV2 S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,1,LRIX,0)=LRTX,$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRIX,0),U,3)=LRINST_";"_LRTRAY_";"_LRCUP
|
|
S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,1,0)="^68.222^"_LRIX_"^1"
|
|
Q
|
|
WHATEST ;from LRLLS
|
|
K X,G2 S G2=0 F I=0:0 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 I '$P(^(I,0),U,3),($D(^LRO(68.2,LRINST,10,LRWPROF,1,"B",I))) S G2=G2+1,G2(G2)=I,G2(G2,0)=^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)
|
|
I G2<1 S X=U W !,"NO TESTS FREE TO ADD" K G2 Q
|
|
S G4="$P(^LAB(60,+G2(I,0),0),U,1)",G1="What test(s) to add?" D GROUP^LRWU2
|
|
F I=0:0 S I=$O(X(I)) Q:I'>0 S ^TMP("LR",$J,"T",G2(I))=G2(I,0)
|
|
K G1,G2,G4 Q
|
|
SHOW ;from LRLLS
|
|
S LRDFN=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)):+^(0),1:-1) Q:LRDFN<1 S X=^LR(LRDFN,0)
|
|
WHO ;from LRLLS
|
|
S LRDPF=$P(X,U,2),DFN=$P(X,U,3) D PT^LRX W !,PNM,?40,SSN Q
|
|
Q
|
|
CURRENT ;from LRLLS
|
|
S X=$S($D(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0)):^(0),1:""),%=0 W:X="" !,"NOTHING THERE" Q:X=""
|
|
S X=$S($D(^LRO(68,+X,1,+$P(X,U,2),1,+$P(X,U,3),0)):^(0),1:"") W:X="" !,"NO ACCESSION THERE" Q:X="" W:X'="" !,"ACCESSION: ",^(.2) S X=^LR(+X,0)
|
|
D WHO W !?10 S %=1 D YN^DICN Q
|
|
DROP ;from LRLLS
|
|
Q:$D(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0))[0 S X=^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0),LRDWL=+$P(X,U,1),LRDWDT=+$P(X,U,2),LRDWLE=+$P(X,U,3)
|
|
I '$D(^LRO(68,LRDWL,1,LRDWDT,1,LRDWLE,0)) K ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP) Q
|
|
S LRDPF=$P(^LRO(68,LRDWL,1,LRDWDT,1,LRDWLE,0),U,2),LRDFN=+^(0) W !,$S($D(^(.2)):^(.2),1:"")
|
|
F T=0:0 S T=$O(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,1,T)) Q:T<1 I $D(^LRO(68,LRDWL,1,LRDWDT,1,LRDWLE,4,T,0)) S $P(^(0),U,3)="" D:LRDPF=62.3 DR2
|
|
K ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP) K:$O(^LRO(68.2,LRINST,1,LRTRAY,1,0))=""&($D(LRHOLD)'=11) ^LRO(68.2,LRINST,1,LRTRAY) Q
|
|
DR2 ;K:$D(LRCTRL) ^LRO(68,LRDWL,1,LRDWDT,1,LRDWLE,4,T) Q ;KILL TEST FROM CONTROL
|
|
Q
|
|
CLRALL ;from LRLLS
|
|
S LRCTRL=1
|
|
F LRTRAY=0:0 S LRTRAY=$O(^LRO(68.2,LRINST,1,LRTRAY)) Q:LRTRAY<1 F LRCUP=0:0 S LRCUP=$O(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP)) Q:LRCUP<1 W !,$J(LRTRAY,3),$J(LRCUP,4) D DROP
|
|
K ^LRO(68.2,LRINST,2) ;CLEAR THE LAST LOAD INFO
|
|
K ^LRO(68.2,LRINST,1),LRCTRL,LRINST,LRTRAY,LRCUP Q
|
|
CLRBYTRY ;clear loadlist by tray, from LRLLS
|
|
W !!,"This option will remove entries from the specified tray(s) and",!,"make the accession(s) again available for adding to a worklist or loadlist.",!
|
|
S LREND=0 D LRINST^LRLLS G END:LRINST<1
|
|
CT1 W !,"STARTING ",$S(LRTYPE:"TRAY",1:"SEQUENCE #"),": FIRST//" R X:DTIME Q:X="^"
|
|
S LRST=$S(X="":1,1:+X) G CT1:LRST<1!(LRST>99999)
|
|
CT2 W !,"LAST ",$S(LRTYPE:"TRAY",1:"SEQUENCE #"),": LAST//" R X:DTIME Q:X="^"
|
|
S LRET=$S(X="":99999,1:+X) G CT2:LRET<1!(LRET>99999) S LRCTRL=1
|
|
W !,"UNLOADING THE FOLLOWING ACCESSIONS"
|
|
F LRTRAY=$S(LRTYPE:LRST,1:1)-.01:0 S LRTRAY=$O(^LRO(68.2,LRINST,1,LRTRAY)) Q:(LRTRAY<1)!(LRTRAY>LRET) D CT2A
|
|
END K LRCTRL,LRST,LRET,LRINST,LRTRAY,LRCUP
|
|
K A,DIC,I,K,LRAD,LRDFN,LRDPF,LRDWDT,LRDWL,LRDWLE,LREND,LRFULL,LRINSTIT,LRMAXCUP,LRTRANS,LRTYPE,T,X,Y,Z
|
|
Q
|
|
CT2A W:LRTYPE !,"TRAY ",LRTRAY F LRCUP=$S(LRTYPE:0,1:LRST-.01):0 S LRCUP=$O(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP)) Q:LRCUP<1!(LRCUP>$S('LRTYPE:LRET,1:99999)) W:'LRTYPE !,"SEQ# ",LRCUP D DROP
|
|
K:LRTYPE ^LRO(68.2,LRINST,1,LRTRAY)
|
|
Q
|