LRLLP ;SLC/RWF - LOAD LIST PRINT ;2/19/91 10:43 ;
;;5.2;LAB SERVICE;**116**;Sep 27, 1994
K DIC,ZTSK,%ZIS,LRTEST W !!,"PRINT LOAD/WORK LIST"
S DIC="^LRO(68.2,",DIC(0)="QAEMZ",DIC("S")="S %=$P(^(0),U,12) X ""I '$L(%)"" Q:$T S %=$P(^DIC(19.1,%,0),U,1) I $D(^XUSEC(%,DUZ))" D ^DIC G KILL:Y<1 S LRINST=+Y,LRTYPE=$P(Y(0),U,3),LRMAXCUP=$P(Y(0),U,4)
S U="^",LRST=1,LRLLT=9999999 D DT^LRX S LRAD=DT
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
EN1 ;from LRLL1
D EN2
KILL ;from LRLL1
K LREXIT
K A,IO("Q"),AGE,DFN,DIC,DIB,I,J,K,LAST,LRACC,LRAD,LRALTH,LRAN,LRCUP,LRFRMT,%,%H,DA,L,LRNOW,LRTSTLM
K LRDC,LRDFN,LRDOC,LRDPF,LRIDT,LRINST,LRLINE,LRLL,LRLLOC,LRLLT
K LRMAXCUP,LRODNUM,LRORD,LRPROF,LRSHORT,LRSPEC,LRST,LRTEST,LRTRAY
K ^TMP("LR",$J,"T"),LRTSTS,LRTYPE,LRURG,LRV,LRWRD,LRXPD,PNM,SEX,SSN,X,Y,Z,LRSISPEC
Q
EN2 ;ENTRY FROM LRLL2
S U="^",X=^LRO(68.2,LRINST,0),LRTYPE=$P(X,U,3),LRXPD=$P(X,U,6),LRLINE="",LRALTH=$P(X,U,9),LRDC=1,LRSHORT=$P(X,U,11),$P(LRLINE,"-",40)=""
I $S($D(^LRO(68.2,LRINST,2)):$P(^(2),U,1),1:0)'=LRAD W !,"LOAD/WORK LIST NOT SETUP FOR THIS DATE"
S LAST=$S($D(^LRO(68.2,LRINST,2)):^(2),1:"^1^1^^"),LRST=$P(LAST,U,$S(LRTYPE:2,1:3)),LRLLT=99999 G LR3:$D(ZTQUEUED)
LR1 W !,$S(LRTYPE=1:"TRAY",1:"SEQUENCE")," # TO START WITH:",LRST,"//" R X:DTIME I X["?" W !?5,"Enter number to start with.",! G LR1
S LRST=$S(X="":LRST,X:+X,1:-1) Q:LRST<1
IF LRTYPE,'$D(^LRO(68.2,LRINST,1,LRST,0)) W $C(7)," NOT SETUP YET" G LR1
LR2 W !?$S(LRTYPE=1:12,1:17),"END WITH: LAST//" R LRLLT:DTIME I LRLLT["?" W !?5,"Enter number to end with",! G LR2
S LRLLT=$S(LRLLT="":999999,LRLLT:+LRLLT,1:-1) Q:LRLLT<1
LR3 S LRST=LRST-.5 S:'LRTYPE LRTRAY=1,LRCUP=LRST S:LRTYPE LRTRAY=LRST,LRCUP=0
I LRTYPE S X=$O(^LRO(68.2,LRINST,1,LRST)) G EMPTY:X<1,EMPTY:$O(^LRO(68.2,LRINST,1,X,1,0))<1
I 'LRTYPE S X=$O(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP)) G EMPTY:X<1
I '$D(ZTQUEUED) S %ZIS="MQ" D ^%ZIS Q:POP
G QUE:$D(IO("Q"))
LR4 D URG^LRX K ^TMP($J)
S %DT="T",X="N" D ^%DT,DD^LRX S LRNOW=Y
U IO
G ^LRLLP3:'LRTYPE,^LRLLP5:LRFRMT="E",^LRLLP2:LRFRMT="C"
Q
EMPTY W !!,"The list is EMPTY and can't be printed",! Q
QUE S ZTRTN="DQ^LRLLP",ZTSAVE("LR*")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTIO,ZTSAVE Q
DQ S:$D(ZTQUEUED) ZTREQ="@" U IO D LR4,KILL Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLLP 2409 printed Apr 09, 2024@21:17:39 Page 2
LRLLP ;SLC/RWF - LOAD LIST PRINT ;2/19/91 10:43 ;
+1 ;;5.2;LAB SERVICE;**116**;Sep 27, 1994
+2 KILL DIC,ZTSK,%ZIS,LRTEST
WRITE !!,"PRINT LOAD/WORK LIST"
+3 SET DIC="^LRO(68.2,"
SET DIC(0)="QAEMZ"
SET DIC("S")="S %=$P(^(0),U,12) X ""I '$L(%)"" Q:$T S %=$P(^DIC(19.1,%,0),U,1) I $D(^XUSEC(%,DUZ))"
DO ^DIC
if Y<1
GOTO KILL
SET LRINST=+Y
SET LRTYPE=$PIECE(Y(0),U,3)
SET LRMAXCUP=$PIECE(Y(0),U,4)
+4 SET U="^"
SET LRST=1
SET LRLLT=9999999
DO DT^LRX
SET LRAD=DT
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
EN1 ;from LRLL1
+1 DO EN2
KILL ;from LRLL1
+1 KILL LREXIT
+2 KILL A,IO("Q"),AGE,DFN,DIC,DIB,I,J,K,LAST,LRACC,LRAD,LRALTH,LRAN,LRCUP,LRFRMT,%,%H,DA,L,LRNOW,LRTSTLM
+3 KILL LRDC,LRDFN,LRDOC,LRDPF,LRIDT,LRINST,LRLINE,LRLL,LRLLOC,LRLLT
+4 KILL LRMAXCUP,LRODNUM,LRORD,LRPROF,LRSHORT,LRSPEC,LRST,LRTEST,LRTRAY
+5 KILL ^TMP("LR",$JOB,"T"),LRTSTS,LRTYPE,LRURG,LRV,LRWRD,LRXPD,PNM,SEX,SSN,X,Y,Z,LRSISPEC
+6 QUIT
EN2 ;ENTRY FROM LRLL2
+1 SET U="^"
SET X=^LRO(68.2,LRINST,0)
SET LRTYPE=$PIECE(X,U,3)
SET LRXPD=$PIECE(X,U,6)
SET LRLINE=""
SET LRALTH=$PIECE(X,U,9)
SET LRDC=1
SET LRSHORT=$PIECE(X,U,11)
SET $PIECE(LRLINE,"-",40)=""
+2 IF $SELECT($DATA(^LRO(68.2,LRINST,2)):$PIECE(^(2),U,1),1:0)'=LRAD
WRITE !,"LOAD/WORK LIST NOT SETUP FOR THIS DATE"
+3 SET LAST=$SELECT($DATA(^LRO(68.2,LRINST,2)):^(2),1:"^1^1^^")
SET LRST=$PIECE(LAST,U,$SELECT(LRTYPE:2,1:3))
SET LRLLT=99999
if $DATA(ZTQUEUED)
GOTO LR3
LR1 WRITE !,$SELECT(LRTYPE=1:"TRAY",1:"SEQUENCE")," # TO START WITH:",LRST,"//"
READ X:DTIME
IF X["?"
WRITE !?5,"Enter number to start with.",!
GOTO LR1
+1 SET LRST=$SELECT(X="":LRST,X:+X,1:-1)
if LRST<1
QUIT
+2 IF LRTYPE
IF '$DATA(^LRO(68.2,LRINST,1,LRST,0))
WRITE $CHAR(7)," NOT SETUP YET"
GOTO LR1
LR2 WRITE !?$SELECT(LRTYPE=1:12,1:17),"END WITH: LAST//"
READ LRLLT:DTIME
IF LRLLT["?"
WRITE !?5,"Enter number to end with",!
GOTO LR2
+1 SET LRLLT=$SELECT(LRLLT="":999999,LRLLT:+LRLLT,1:-1)
if LRLLT<1
QUIT
LR3 SET LRST=LRST-.5
if 'LRTYPE
SET LRTRAY=1
SET LRCUP=LRST
if LRTYPE
SET LRTRAY=LRST
SET LRCUP=0
+1 IF LRTYPE
SET X=$ORDER(^LRO(68.2,LRINST,1,LRST))
if X<1
GOTO EMPTY
if $ORDER(^LRO(68.2,LRINST,1,X,1,0))<1
GOTO EMPTY
+2 IF 'LRTYPE
SET X=$ORDER(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP))
if X<1
GOTO EMPTY
+3 IF '$DATA(ZTQUEUED)
SET %ZIS="MQ"
DO ^%ZIS
if POP
QUIT
+4 if $DATA(IO("Q"))
GOTO QUE
LR4 DO URG^LRX
KILL ^TMP($JOB)
+1 SET %DT="T"
SET X="N"
DO ^%DT
DO DD^LRX
SET LRNOW=Y
+2 USE IO
+3 if 'LRTYPE
GOTO ^LRLLP3
if LRFRMT="E"
GOTO ^LRLLP5
if LRFRMT="C"
GOTO ^LRLLP2
+4 QUIT
EMPTY WRITE !!,"The list is EMPTY and can't be printed",!
QUIT
QUE SET ZTRTN="DQ^LRLLP"
SET ZTSAVE("LR*")=""
DO ^%ZTLOAD
KILL ZTSK,ZTRTN,ZTIO,ZTSAVE
QUIT
DQ if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
DO LR4
DO KILL
QUIT
