source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRLSTWRK.m@ 1250

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