LRACS ;SLC/DCM - DAILY LAB SUMMARY REPORTS ;2/19/91 10:18 ;
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
K X2 D:$D(ZTQUEUED) DQ U IO W @IOF
S LRDT=$P(^LAB(64.5,1,0),U,3) Q:LRDT="" S LRLDT=$S('$L($P(^LAB(64.5,1,0),U,7)):LRDT,1:$P(^LAB(64.5,1,0),U,7))
S LRFUL=0 F S LRFUL=$O(^LAB(64.5,1,2,LRFUL)) Q:LRFUL<1 K ^TMP($J) S LRFULL=LRFUL D LRFULL
END D:$D(ZTQUEUED) DQ S LRDT=$P(^LAB(64.5,1,0),U,3) Q:LRDT="" S LRLDT=$S('$L($P(^LAB(64.5,1,0),U,7)):LRDT,1:$P(^LAB(64.5,1,0),U,7)) D ^LRACS3
D KILL,^%ZISC
K LRFULL,LRFUL,^TMP($J) Q
MANUAL K X2,IO("Q") S %ZIS="QM" D ^%ZIS Q:POP U IO(0) K LRALL
M1 W !,"Print ALL Supervisor Reports" S %=2 D YN^DICN G M1:%=0 Q:%<0 S:%=1 LRALL=1
I '$D(LRALL) S DIC="^LAB(64.5,1,2,",DIC(0)="AEMQ" D ^DIC S LRFULL=+Y I Y<1 D PREEND Q:%<0
S ZTRTN=$S($D(LRALL):"^LRACS",$D(LRMISC):"END^LRACS",1:"LRFULL^LRACS")
I $D(IO("Q")) K IO("Q") S ZTDESC="Lab supervisors summary" F I="LR*","U","DT" S ZTSAVE(I)=""
I D ^%ZTLOAD K ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK Q
U IO
D @ZTRTN
D ^%ZISC K ^TMP($J) Q
LRFULL D:$D(ZTQUEUED) DQ Q:LRFULL<1 S LRLTR=$P(^LAB(64.5,1,2,LRFULL,0),U,1) D ^LRLTR
S LRDT=$P(^LAB(64.5,1,0),U,3) Q:LRDT="" S LRLDT=$S('$L($P(^LAB(64.5,1,0),U,7)):LRDT,1:$P(^LAB(64.5,1,0),U,7))
S LRCLUS="" S LRNEX=0 F S LRNEX=$O(^LAB(64.5,1,2,LRFULL,1,LRNEX)) Q:LRNEX<1 S LRCLUS=LRCLUS_U_^(LRNEX,0)
CL2 ;
QUE ;
S U="^",LRBOT=$P(^LAB(64.5,1,0),U,2),LRTD=$P(^(1,0),U,3)
W @IOF W "Reporting Period: " S Y=LRLDT S Y=$$Y2K^LRX(Y) W Y," to " S Y=LRDT S Y=$$Y2K^LRX(Y) W Y,!
S LRIDT=0,LRRE=0,LRLLOC="",LRAG=0 D DT^LRX S LRCDT=LRDT0
ENT K LRMIC S LRXLR="LRAC",LRLLOC=-1,LRSORT=$S($D(^LAB(64.5,1,4)):$P(^(4),U,1),1:"") I '$D(^TMP($J,LRDT,"NOKILL")) K ^TMP($J) S ^TMP($J,LRDT,"NOKILL")="" DO LRLLOC
D:LRSORT SORT^LRACS2 W @IOF D KILL Q
LRLLOC F LRIM=0:0 S LRLLOC=$O(^LRO(69,LRDT,1,"AR",LRLLOC)) Q:LRLLOC="" S LRNM=-1,LRSTART=0 D:'LRSORT EQUALS^LRX W:'LRSORT !,?15,"*** "_LRLLOC_" ***" D LRNM
Q
LRNM F J=0:0 S LRNM=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM)) Q:LRNM="" D LRDFN
Q
LRDFN S LRIDT=0,LRDFN=0 F S LRDFN=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM,LRDFN)) Q:LRDFN<1 Q:$D(^LR(LRDFN,0))[0 S LRIL=0,LRNAME=0,LRPG=1,LRAG=0,LRYESCOM=0 S:LRSORT ^TMP($J,LRNM,LRDFN)=LRLLOC D:'LRSORT LRMH^LRACS1
Q
PREEND K LRMISC W !!,"DO YOU WANT TO PRINT THE MISCELLANEOUS REPORT" S %=2 D YN^DICN G PREEND:%=0 Q:%<0 I %=1 S LRMISC=1 Q
Q
DQ S:$D(ZTQUEUED) ZTREQ="@" Q
KILL K I,J,K,LRACT,LRAG,LRALL,LRBOT,LRCDT,LRCLUS,LRCTR,LRCW,LRDP,LRF,LRFALT,LRFDT,LRFFDT,LRFMT,LRHOLD,LRII,LRIM,LRIP,LRIQ,LRIT,LRJS,LRFDT,LRLFDT,LRMH,LRMHN,LRMOM,LRNEX,LRNP,LROSH,LRPL,LRRE,LRSH,LRSHD,LRSHN,LRSTART,LRTD,LRTLOC,LRTOM,LRTOPP
K LRTOT,LRTS,LRAG,LRCL,LRDFN,LRDT,LRFULL,LRIDT,LRIL,LRLDT,LRLLOC,LRNAME,LRNM,LRPG,LRSORT,LRVDT,LRYESCOM,ZTRTN,AGE,LRHI,LRLO,LRLTR,LRMIT,LRSPE,LRSPEM,LRTEST,LRTIM,LRUDT,LRUNT,X3,ZTDESC,ZTIO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRACS 2840 printed Nov 22, 2024@17:16:37 Page 2
LRACS ;SLC/DCM - DAILY LAB SUMMARY REPORTS ;2/19/91 10:18 ;
+1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
+2 KILL X2
if $DATA(ZTQUEUED)
DO DQ
USE IO
WRITE @IOF
+3 SET LRDT=$PIECE(^LAB(64.5,1,0),U,3)
if LRDT=""
QUIT
SET LRLDT=$SELECT('$LENGTH($PIECE(^LAB(64.5,1,0),U,7)):LRDT,1:$PIECE(^LAB(64.5,1,0),U,7))
+4 SET LRFUL=0
FOR
SET LRFUL=$ORDER(^LAB(64.5,1,2,LRFUL))
if LRFUL<1
QUIT
KILL ^TMP($JOB)
SET LRFULL=LRFUL
DO LRFULL
END if $DATA(ZTQUEUED)
DO DQ
SET LRDT=$PIECE(^LAB(64.5,1,0),U,3)
if LRDT=""
QUIT
SET LRLDT=$SELECT('$LENGTH($PIECE(^LAB(64.5,1,0),U,7)):LRDT,1:$PIECE(^LAB(64.5,1,0),U,7))
DO ^LRACS3
+1 DO KILL
DO ^%ZISC
+2 KILL LRFULL,LRFUL,^TMP($JOB)
QUIT
MANUAL KILL X2,IO("Q")
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
USE IO(0)
KILL LRALL
M1 WRITE !,"Print ALL Supervisor Reports"
SET %=2
DO YN^DICN
if %=0
GOTO M1
if %<0
QUIT
if %=1
SET LRALL=1
+1 IF '$DATA(LRALL)
SET DIC="^LAB(64.5,1,2,"
SET DIC(0)="AEMQ"
DO ^DIC
SET LRFULL=+Y
IF Y<1
DO PREEND
if %<0
QUIT
+2 SET ZTRTN=$SELECT($DATA(LRALL):"^LRACS",$DATA(LRMISC):"END^LRACS",1:"LRFULL^LRACS")
+3 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="Lab supervisors summary"
FOR I="LR*","U","DT"
SET ZTSAVE(I)=""
+4 IF $TEST
DO ^%ZTLOAD
KILL ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK
QUIT
+5 USE IO
+6 DO @ZTRTN
+7 DO ^%ZISC
KILL ^TMP($JOB)
QUIT
LRFULL if $DATA(ZTQUEUED)
DO DQ
if LRFULL<1
QUIT
SET LRLTR=$PIECE(^LAB(64.5,1,2,LRFULL,0),U,1)
DO ^LRLTR
+1 SET LRDT=$PIECE(^LAB(64.5,1,0),U,3)
if LRDT=""
QUIT
SET LRLDT=$SELECT('$LENGTH($PIECE(^LAB(64.5,1,0),U,7)):LRDT,1:$PIECE(^LAB(64.5,1,0),U,7))
+2 SET LRCLUS=""
SET LRNEX=0
FOR
SET LRNEX=$ORDER(^LAB(64.5,1,2,LRFULL,1,LRNEX))
if LRNEX<1
QUIT
SET LRCLUS=LRCLUS_U_^(LRNEX,0)
CL2 ;
QUE ;
+1 SET U="^"
SET LRBOT=$PIECE(^LAB(64.5,1,0),U,2)
SET LRTD=$PIECE(^(1,0),U,3)
+2 WRITE @IOF
WRITE "Reporting Period: "
SET Y=LRLDT
SET Y=$$Y2K^LRX(Y)
WRITE Y," to "
SET Y=LRDT
SET Y=$$Y2K^LRX(Y)
WRITE Y,!
+3 SET LRIDT=0
SET LRRE=0
SET LRLLOC=""
SET LRAG=0
DO DT^LRX
SET LRCDT=LRDT0
ENT KILL LRMIC
SET LRXLR="LRAC"
SET LRLLOC=-1
SET LRSORT=$SELECT($DATA(^LAB(64.5,1,4)):$PIECE(^(4),U,1),1:"")
IF '$DATA(^TMP($JOB,LRDT,"NOKILL"))
KILL ^TMP($JOB)
SET ^TMP($JOB,LRDT,"NOKILL")=""
DO LRLLOC
+1 if LRSORT
DO SORT^LRACS2
WRITE @IOF
DO KILL
QUIT
LRLLOC FOR LRIM=0:0
SET LRLLOC=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC))
if LRLLOC=""
QUIT
SET LRNM=-1
SET LRSTART=0
if 'LRSORT
DO EQUALS^LRX
if 'LRSORT
WRITE !,?15,"*** "_LRLLOC_" ***"
DO LRNM
+1 QUIT
LRNM FOR J=0:0
SET LRNM=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM))
if LRNM=""
QUIT
DO LRDFN
+1 QUIT
LRDFN SET LRIDT=0
SET LRDFN=0
FOR
SET LRDFN=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM,LRDFN))
if LRDFN<1
QUIT
if $DATA(^LR(LRDFN,0))[0
QUIT
SET LRIL=0
SET LRNAME=0
SET LRPG=1
SET LRAG=0
SET LRYESCOM=0
if LRSORT
SET ^TMP($JOB,LRNM,LRDFN)=LRLLOC
if 'LRSORT
DO LRMH^LRACS1
+1 QUIT
PREEND KILL LRMISC
WRITE !!,"DO YOU WANT TO PRINT THE MISCELLANEOUS REPORT"
SET %=2
DO YN^DICN
if %=0
GOTO PREEND
if %<0
QUIT
IF %=1
SET LRMISC=1
QUIT
+1 QUIT
DQ if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
KILL KILL I,J,K,LRACT,LRAG,LRALL,LRBOT,LRCDT,LRCLUS,LRCTR,LRCW,LRDP,LRF,LRFALT,LRFDT,LRFFDT,LRFMT,LRHOLD,LRII,LRIM,LRIP,LRIQ,LRIT,LRJS,LRFDT,LRLFDT,LRMH,LRMHN,LRMOM,LRNEX,LRNP,LROSH,LRPL,LRRE,LRSH,LRSHD,LRSHN,LRSTART,LRTD,LRTLOC,LRTOM,LRTOPP
+1 KILL LRTOT,LRTS,LRAG,LRCL,LRDFN,LRDT,LRFULL,LRIDT,LRIL,LRLDT,LRLLOC,LRNAME,LRNM,LRPG,LRSORT,LRVDT,LRYESCOM,ZTRTN,AGE,LRHI,LRLO,LRLTR,LRMIT,LRSPE,LRSPEM,LRTEST,LRTIM,LRUDT,LRUNT,X3,ZTDESC,ZTIO
+2 QUIT
