- 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 Feb 18, 2025@23:32:25 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
