74 lines
3.6 KiB
Mathematica
74 lines
3.6 KiB
Mathematica
LRLSTWRK ;SLC/CJS/DALISC/DRH - BRIEF ACCESSION LIST ;2/19/91 10:44 ;
|
|
;;5.2;LAB SERVICE;**153**;Sep 27, 1994
|
|
EN ;
|
|
K ^TMP($J),LRTEST,LR,LRTSTS,LRAA
|
|
D ADATE^LRWU3
|
|
G END^LRLSTWRL:LREND
|
|
S LRAD=Y,DIC="^LRO(68,",DIC(0)="AEMOQ",LR(1)=0,LRTEST(0)=0
|
|
D LRAA^LRLSTWRL G END:LREND,LRLSTWRK:LR(1)<1
|
|
I '$D(LRSTAR) S LREND=0 D LRAN^LRWU3 G END:LREND
|
|
L2 ;
|
|
W !,"Expand panels" S %=2 D YN^DICN
|
|
S LREX=(%=1)
|
|
G END:%=-1
|
|
I %=0 W !,"If yes, each panel encountered will be expanded." G L2
|
|
L2B ;
|
|
W !,"Do you wish to see unverified data"
|
|
S %=2 D YN^DICN
|
|
S LR(2)=(%=1)
|
|
G END:%=-1
|
|
I %=0 W !,"If yes, unverified data may also be displayed." G L2B
|
|
L2A ;
|
|
S LREND=0,LRCEN("W")=0
|
|
R !,"Spacing: 1// ",LR(4):DTIME
|
|
Q:'$T!(LR(4)["^") W:LR(4)["?" !,"Single, Double, Triple spacing, etc."
|
|
G:X["?" L2A S LR(4)=+LR(4) S:LR(4)<1 LR(4)=1
|
|
S %ZIS="QM" D ^%ZIS G END:POP
|
|
I $D(IO("Q")) D G END
|
|
. S ZTRTN="DQ^LRLSTWRK",ZTSAVE("L*")=""
|
|
. D ^%ZTLOAD K ZTSK,ZTRTN,ZTIO,ZTSAVE,IO("Q")
|
|
ENT ;
|
|
U IO D URG^LRX K ^TMP("LR",$J)
|
|
S LRNTPP=((IOM-4)-45)/$S(LR(4)>1:7,1:5)\1,LRNTP=0
|
|
I '$D(LRSTAR) F LRAA=1:1:LR(1) D L11 Q:LREND
|
|
I $D(LRSTAR) F LRAA=1:1:LR(1) D L3 Q:LREND
|
|
I $O(^TMP($J,0))<1 W !!,"NO DATA TO REPORT" G END
|
|
S:LRTEST(0)<LRNTPP LRNTPP=LRTEST(0) G EN^LRLSTWRL
|
|
Q
|
|
L11 W "." S LRAN=LRFAN-1 F K=0:0 S LRAN=$O(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN)) Q:LRAN=""!(LRAN>LRLAN) D L12 Q:LREND
|
|
Q
|
|
L12 Q:'$D(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,0))#2
|
|
S X=^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,0),LRCEN=$S($D(^(.1)):^(.1),1:0),LRACC=$S($D(^(.2)):^(.2),1:"?"),LRIDT=$S($D(^(3)):^(3),1:"")
|
|
S LRUID=$P($G(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,.3)),"^")
|
|
S T(2)="",T(5)="",T(3)="",LRDFN=+X,LRSDT=$P(X,U,4)\1,LRSN=+$P(X,U,5),LRLLOC=$P(X,U,7)
|
|
S:LRCEN&'LRCEN("W") LRCEN("W")=1
|
|
I LRIDT'="" D
|
|
. I +LRIDT S T(2)=+LRIDT_$S($P(LRIDT,U,2):"r",1:"d")
|
|
. E S T(2)="No Collect Date/Time"
|
|
. S T(3)=$P(LRIDT,U,4),T(5)=$P(LRIDT,U,3),LRIDT=$P(LRIDT,U,5)
|
|
S II=0 F S II=$O(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,4,II)) Q:II<1!LREND S X=^(II,0) D L13
|
|
S LR(3)=$S(LR(4)>1:7,1:5)*LRTEST(0)+67+$S('LRCEN("W"):0,1:8)<(IOM-4) S:LR(3) LR(3)=22+$S('LRCEN("W"):0,1:8)
|
|
Q
|
|
L13 S T(1)=$P(X,U,6),LRURG=+$P(X,U,2),LRURG=$S($D(LRURG(LRURG)):LRURG(LRURG),1:""),T(3)=$P(X,U,5),LRTS=+X
|
|
I $G(LRURG)>49,'$P($G(LRPARAM),U,3) Q
|
|
S T(4)=$S(T(3):"done",$L(T(1)):"#"_$J(T(1),3),LRURG["STAT":"Spen",1:" pen"),LRSPEC=$S($D(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,5,1,0)):+^(0),1:""),S4=$S($D(^LAB(60,LRTS,0)):$P(^(0),U,5),1:""),T4=T(4)
|
|
D STORE I LREX S LRTEST=LRTS,LRTSTLM=100 D ^LREXPD S JJ=0 F S JJ=$O(LRORD(JJ)) Q:JJ<1 S LRTS=LRORD(JJ),S4=$P(^LAB(60,LRTS,0),U,5) D STORE
|
|
K JJ,LRORD,^TMP("LR",$J,"T") Q
|
|
STORE S:'$D(LRTEST("B",LRTS)) LRTEST(0)=LRTEST(0)+1,LRTEST(LRTEST(0))=$S($D(^LAB(60,LRTS,0)):$P(^(0),U,1),1:"deleted test"),LRTEST("B",LRTS)=LRTEST(0),LRNTP=LRTEST(0)-1\LRNTPP+1
|
|
S LRSS=$P(S4,";",1),S2=$P(S4,";",2),S3=$P(S4,";",3),T(4)=T4
|
|
I $L(S4) D
|
|
. S T(4)=$S(LRURG["STAT":"S...",1:"....")
|
|
. I LRIDT,$D(^LR(LRDFN,LRSS,LRIDT,S2)),$P(^(0),U,3)!LR(2),$L($P(^(S2),U,S3)) S T(4)=$S($P(^(S2),U,S3)'="pending":$P(^(S2),U,S3),1:"pen")
|
|
S ^TMP($J,(LRTEST("B",LRTS)-1\LRNTPP+1),LRAN,LRACC,LRDFN,LRTEST("B",LRTS))=LRLLOC_U_LRURG_U_T(4)_U_LRSPEC_U_LRCEN_U_T(2)_U_LRACC_U_T(5)_U_LRUID
|
|
Q
|
|
END G END^LRLSTWRL
|
|
Q
|
|
YN R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G YN
|
|
L3 S LRAD=$E(LRSTAR,1,3)_"0000"-.00001 F S LRAD=$O(^LRO(68,LRAA(LRAA),1,LRAD)) Q:LRAD<1!(LRAD>LRWDTL) D AC Q:LREND
|
|
AC S T1=LRSTAR-.00001 F S T1=$O(^LRO(68,+LRAA(LRAA),1,+LRAD,1,"E",T1)) Q:T1<1!(LAST>1&(T1\1>LAST)) D AC1
|
|
Q
|
|
AC1 S LRAN=0 F S LRAN=$O(^LRO(68,+LRAA(LRAA),1,LRAD,1,"E",T1,LRAN)) Q:LRAN<1 I $D(^LRO(68,+LRAA(LRAA),1,LRAD,1,LRAN,0)) D L12 Q:LREND
|
|
Q
|
|
DQ S:$D(ZTQUEUED) ZTREQ="@" U IO K ^TMP($J) G ENT
|
|
Q
|