- 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 Mar 13, 2025@21:20: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
