LRLL ;SLC/RWF - LOAD LIST CONTROL ;2/19/91 10:41 ;
;;5.2;LAB SERVICE;**21,116,153**;Sep 27, 1994
K DIC,%ZIS,ZTSK,LRCTRL,LRDSPEC,LRALL,LRTEST
S U="^",LRST=1,LRLLT=9999999,LRFULL=0,LRHOLD=+^LAB(69.9,1,3) D DT^LRX K DIC
S DIC="^LRO(68.2,",DIC(0)="AEMZ",DIC("S")="S %=$P(^(0),U,12) X ""I '$L(%),'$D(^DIC(19.1,+%,0))"" Q:$T S %=$P(^DIC(19.1,%,0),U,1) I $D(^XUSEC(%,DUZ))" D ^DIC G:Y<1 KILL S LRINST=+Y
L1 ;
I $S($D(^LRO(68.2,LRINST,3)):^(3),1:0) W !,"Waiting for another build to finish.",$C(7),!!?5,"Type '^' to stop waiting." R X:DTIME G L1:X'[U G KILL
S LRTRANS=+$P(Y(0),U,2),LRTYPE=+$P(Y(0),U,3),LRFULL=$P(Y(0),U,5),LRLLINIT=+$P(Y(0),U,7),LRMAXCUP=+$P(Y(0),U,4),LRLLP(1)=$P(Y(0),U,10)
S LRTRANS=$S($D(^LAB(62.07,LRTRANS,.1)):^(.1),1:"S LRCUP=LRCUP+1"),LRLLINIT=$S($D(^LAB(62.07,LRLLINIT,.1)):^(.1),1:"Q")
S LRPROF=$O(^LRO(68.2,LRINST,10,0)) I LRPROF<1 W !,"No profile defined." D KILL Q
S B=$O(^LRO(68.2,LRINST,10,LRPROF))
PRO K DIC("S") I B>0 W !,"ALL PROFILES" S %=2 D YN^DICN G:%<0 KILL S:%=1 LRALL=1 I %'=1 S DIC="^LRO(68.2,"_LRINST_",10," D ^DIC Q:Y<1 S LRPROF=+Y
AS W !,"(C)ondensed or (E)xpanded list ? (req. 132 column format):C//" R LRFRMT:DTIME Q:'$T!(LRFRMT[U) S LRFRMT=$E(LRFRMT) S:LRFRMT']"" LRFRMT="C" I LRFRMT'="C"&(LRFRMT'="E") W !,"Answer C or E" G AS
D PROF^LRLL3,^LRLL1A
KILL K %,%DT,%H,%ZIS,A,AGE,AN,B,C,D,DA,DFN,DIB,DIC,DOB,E,G,G1,G2,G4,I,I1,J,J1,K,L,L1,L2,L3,LAST,LRAA,LRAAN,LRACC,LRAD,LRADD,LRALL,LRALTH,LRAN,LRCDT,LRCNT
K LRCT,LRCTRL,LRCUP,LRDC,LRDEF,LRDOC,LRDPF,LRDSPEC,LRDWDT,LRDWL,LRDWLE,LREND,LRET,LREXEC,LRFRMT,LRFULL,LRHD,LRHDT,LRHOLD,LRIDT,LRIFN,LRIIX,LRIX,LRINST,LRINSTIT,LRLLOC,LRLLP,LRLLT,LRLLX,LRLST,LRLWN,LRMAXCUP,LRNOLABL,LRNOW,LRODNUM
K LRLINE,LRLL,LRLL1,LRLL2,LRLLINIT,IO("Q")
K LRORD,LRPCUP,LRPGM,LRPROF,LRPTRAY,LRPWDT,LRPWL,LRPWLE,LRSHORT,LRSN,LRSPEC,LRSP,LRSPLIT,LRST,LRSTAR,LRSTART,LRTECH,LRTEST,LRTI,LRTIME,LRTK,LRTP,LRTRACNT,LRTRANS,LRTRAY,LRTSL,LRTST,LRTSTLM,LRTSTS,LRTX,LRTYPE,LRURG,LRURX,LRUS,LRV
K LRWDTL,LRWPROF,LRWRD,LRXPD,PNM,POP,S,S1,S2,SEX,SSN,T,T1,W,X,X9,Z
Q
LOAD ;
S:$D(ZTQUEUED) ZTREQ="@" S U="^",LRHD="Listing of Active Load Work List",LRHDT=(80-$L(LRHD))/2
S LREND=0 D HEAD
S I=0 F S I=$O(^LRO(68.2,I)) Q:I<1 S X=0 F S X=$O(^LRO(68.2,I,1,X)) Q:X<1!(LREND) I $D(^(X,0)) S X=^(0) D
. Q:'$D(^LRO(68,+$P(X,U,4),0))#2
. S LRLWN=$P(^LRO(68.2,I,0),U),Y=$P(X,U,2),LRTECH=$P(X,U,3),LRAAN=$S($P(X,U,4)]"":$P(^LRO(68,$P(X,U,4),0),U),1:"Unknown") D WRITE
I '$D(LRLWN) W !?20,"******** None Found ********",! K LRHD,LRHDT,LREND,I,LRAAN Q
W !," * = Greater than 1 DAY Old ",! K S,I,X,LREND,LRHD,LRHDT,LRLWN,LRTECH,LRAAN,AN
Q
HEAD ;
W @IOF W !?LRHDT,LRHD,!!,"Load Work List Name",?24,"Date ",?36,"User Name",?57,"Acession Area",!
Q
WRITE ;
I IOST["C",$Y>(IOSL-5) W !!," * = Greater than 1 DAY Old " R !!,"Press Any Key to Continue ... ""^"" to Escape ",AN:$S($D(DTIME):DTIME,1:60) I '$T!(AN["^") S LREND=1 Q
D:$Y>(IOSL-5) HEAD S S=$S((DT-Y>1):"*",1:"") D DD^LRX W !?5,LRLWN,?22,Y_S,?34,$S($D(^VA(200,+LRTECH,0)):$P(^(0),U),1:"Unknown"),?60,LRAAN
Q
ASK K %ZIS S %ZIS="QN" D ^%ZIS K:POP %ZIS Q:POP I IO'=IO(0) S ZTRTN="LOAD^LRLL",ZTIO=ION,ZTDESC="Print Active Load Worklist " D ^%ZTLOAD K ZTDTH,ZTDESC,ZTIO,ZTRTN,IO("Q"),%ZIS W !,"Listing Queued To Device ",ION,! D ^%ZISC Q
D LOAD K %ZIS D ^%ZISC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLL 3321 printed Nov 22, 2024@17:26:18 Page 2
LRLL ;SLC/RWF - LOAD LIST CONTROL ;2/19/91 10:41 ;
+1 ;;5.2;LAB SERVICE;**21,116,153**;Sep 27, 1994
+2 KILL DIC,%ZIS,ZTSK,LRCTRL,LRDSPEC,LRALL,LRTEST
+3 SET U="^"
SET LRST=1
SET LRLLT=9999999
SET LRFULL=0
SET LRHOLD=+^LAB(69.9,1,3)
DO DT^LRX
KILL DIC
+4 SET DIC="^LRO(68.2,"
SET DIC(0)="AEMZ"
SET DIC("S")="S %=$P(^(0),U,12) X ""I '$L(%),'$D(^DIC(19.1,+%,0))"" Q:$T S %=$P(^DIC(19.1,%,0),U,1) I $D(^XUSEC(%,DUZ))"
DO ^DIC
if Y<1
GOTO KILL
SET LRINST=+Y
L1 ;
+1 IF $SELECT($DATA(^LRO(68.2,LRINST,3)):^(3),1:0)
WRITE !,"Waiting for another build to finish.",$CHAR(7),!!?5,"Type '^' to stop waiting."
READ X:DTIME
if X'[U
GOTO L1
GOTO KILL
+2 SET LRTRANS=+$PIECE(Y(0),U,2)
SET LRTYPE=+$PIECE(Y(0),U,3)
SET LRFULL=$PIECE(Y(0),U,5)
SET LRLLINIT=+$PIECE(Y(0),U,7)
SET LRMAXCUP=+$PIECE(Y(0),U,4)
SET LRLLP(1)=$PIECE(Y(0),U,10)
+3 SET LRTRANS=$SELECT($DATA(^LAB(62.07,LRTRANS,.1)):^(.1),1:"S LRCUP=LRCUP+1")
SET LRLLINIT=$SELECT($DATA(^LAB(62.07,LRLLINIT,.1)):^(.1),1:"Q")
+4 SET LRPROF=$ORDER(^LRO(68.2,LRINST,10,0))
IF LRPROF<1
WRITE !,"No profile defined."
DO KILL
QUIT
+5 SET B=$ORDER(^LRO(68.2,LRINST,10,LRPROF))
PRO KILL DIC("S")
IF B>0
WRITE !,"ALL PROFILES"
SET %=2
DO YN^DICN
if %<0
GOTO KILL
if %=1
SET LRALL=1
IF %'=1
SET DIC="^LRO(68.2,"_LRINST_",10,"
DO ^DIC
if Y<1
QUIT
SET LRPROF=+Y
AS WRITE !,"(C)ondensed or (E)xpanded list ? (req. 132 column format):C//"
READ LRFRMT:DTIME
if '$TEST!(LRFRMT[U)
QUIT
SET LRFRMT=$EXTRACT(LRFRMT)
if LRFRMT']""
SET LRFRMT="C"
IF LRFRMT'="C"&(LRFRMT'="E")
WRITE !,"Answer C or E"
GOTO AS
+1 DO PROF^LRLL3
DO ^LRLL1A
KILL KILL %,%DT,%H,%ZIS,A,AGE,AN,B,C,D,DA,DFN,DIB,DIC,DOB,E,G,G1,G2,G4,I,I1,J,J1,K,L,L1,L2,L3,LAST,LRAA,LRAAN,LRACC,LRAD,LRADD,LRALL,LRALTH,LRAN,LRCDT,LRCNT
+1 KILL LRCT,LRCTRL,LRCUP,LRDC,LRDEF,LRDOC,LRDPF,LRDSPEC,LRDWDT,LRDWL,LRDWLE,LREND,LRET,LREXEC,LRFRMT,LRFULL,LRHD,LRHDT,LRHOLD,LRIDT,LRIFN,LRIIX,LRIX,LRINST,LRINSTIT,LRLLOC,LRLLP,LRLLT,LRLLX,LRLST,LRLWN,LRMAXCUP,LRNOLABL,LRNOW,LRODNUM
+2 KILL LRLINE,LRLL,LRLL1,LRLL2,LRLLINIT,IO("Q")
+3 KILL LRORD,LRPCUP,LRPGM,LRPROF,LRPTRAY,LRPWDT,LRPWL,LRPWLE,LRSHORT,LRSN,LRSPEC,LRSP,LRSPLIT,LRST,LRSTAR,LRSTART,LRTECH,LRTEST,LRTI,LRTIME,LRTK,LRTP,LRTRACNT,LRTRANS,LRTRAY,LRTSL,LRTST,LRTSTLM,LRTSTS,LRTX,LRTYPE,LRURG,LRURX,LRUS,LRV
+4 KILL LRWDTL,LRWPROF,LRWRD,LRXPD,PNM,POP,S,S1,S2,SEX,SSN,T,T1,W,X,X9,Z
+5 QUIT
LOAD ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
SET U="^"
SET LRHD="Listing of Active Load Work List"
SET LRHDT=(80-$LENGTH(LRHD))/2
+2 SET LREND=0
DO HEAD
+3 SET I=0
FOR
SET I=$ORDER(^LRO(68.2,I))
if I<1
QUIT
SET X=0
FOR
SET X=$ORDER(^LRO(68.2,I,1,X))
if X<1!(LREND)
QUIT
IF $DATA(^(X,0))
SET X=^(0)
Begin DoDot:1
+4 if '$DATA(^LRO(68,+$PIECE(X,U,4),0))#2
QUIT
+5 SET LRLWN=$PIECE(^LRO(68.2,I,0),U)
SET Y=$PIECE(X,U,2)
SET LRTECH=$PIECE(X,U,3)
SET LRAAN=$SELECT($PIECE(X,U,4)]"":$PIECE(^LRO(68,$PIECE(X,U,4),0),U),1:"Unknown")
DO WRITE
End DoDot:1
+6 IF '$DATA(LRLWN)
WRITE !?20,"******** None Found ********",!
KILL LRHD,LRHDT,LREND,I,LRAAN
QUIT
+7 WRITE !," * = Greater than 1 DAY Old ",!
KILL S,I,X,LREND,LRHD,LRHDT,LRLWN,LRTECH,LRAAN,AN
+8 QUIT
HEAD ;
+1 WRITE @IOF
WRITE !?LRHDT,LRHD,!!,"Load Work List Name",?24,"Date ",?36,"User Name",?57,"Acession Area",!
+2 QUIT
WRITE ;
+1 IF IOST["C"
IF $Y>(IOSL-5)
WRITE !!," * = Greater than 1 DAY Old "
READ !!,"Press Any Key to Continue ... ""^"" to Escape ",AN:$SELECT($DATA(DTIME):DTIME,1:60)
IF '$TEST!(AN["^")
SET LREND=1
QUIT
+2 if $Y>(IOSL-5)
DO HEAD
SET S=$SELECT((DT-Y>1):"*",1:"")
DO DD^LRX
WRITE !?5,LRLWN,?22,Y_S,?34,$SELECT($DATA(^VA(200,+LRTECH,0)):$PIECE(^(0),U),1:"Unknown"),?60,LRAAN
+3 QUIT
ASK KILL %ZIS
SET %ZIS="QN"
DO ^%ZIS
if POP
KILL %ZIS
if POP
QUIT
IF IO'=IO(0)
SET ZTRTN="LOAD^LRLL"
SET ZTIO=ION
SET ZTDESC="Print Active Load Worklist "
DO ^%ZTLOAD
KILL ZTDTH,ZTDESC,ZTIO,ZTRTN,IO("Q"),%ZIS
WRITE !,"Listing Queued To Device ",ION,!
DO ^%ZISC
QUIT
+1 DO LOAD
KILL %ZIS
DO ^%ZISC
QUIT
