source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRACS.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1LRACS ;SLC/DCM - DAILY LAB SUMMARY REPORTS ;2/19/91 10:18 ;
2 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
3 K X2 D:$D(ZTQUEUED) DQ U IO W @IOF
4 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))
5 S LRFUL=0 F S LRFUL=$O(^LAB(64.5,1,2,LRFUL)) Q:LRFUL<1 K ^TMP($J) S LRFULL=LRFUL D LRFULL
6END 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
7 D KILL,^%ZISC
8 K LRFULL,LRFUL,^TMP($J) Q
9MANUAL K X2,IO("Q") S %ZIS="QM" D ^%ZIS Q:POP U IO(0) K LRALL
10M1 W !,"Print ALL Supervisor Reports" S %=2 D YN^DICN G M1:%=0 Q:%<0 S:%=1 LRALL=1
11 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
12 S ZTRTN=$S($D(LRALL):"^LRACS",$D(LRMISC):"END^LRACS",1:"LRFULL^LRACS")
13 I $D(IO("Q")) K IO("Q") S ZTDESC="Lab supervisors summary" F I="LR*","U","DT" S ZTSAVE(I)=""
14 I D ^%ZTLOAD K ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK Q
15 U IO
16 D @ZTRTN
17 D ^%ZISC K ^TMP($J) Q
18LRFULL D:$D(ZTQUEUED) DQ Q:LRFULL<1 S LRLTR=$P(^LAB(64.5,1,2,LRFULL,0),U,1) D ^LRLTR
19 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))
20 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)
21CL2 ;
22QUE ;
23 S U="^",LRBOT=$P(^LAB(64.5,1,0),U,2),LRTD=$P(^(1,0),U,3)
24 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,!
25 S LRIDT=0,LRRE=0,LRLLOC="",LRAG=0 D DT^LRX S LRCDT=LRDT0
26ENT 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
27 D:LRSORT SORT^LRACS2 W @IOF D KILL Q
28LRLLOC 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
29 Q
30LRNM F J=0:0 S LRNM=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM)) Q:LRNM="" D LRDFN
31 Q
32LRDFN 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
33 Q
34PREEND 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
35 Q
36DQ S:$D(ZTQUEUED) ZTREQ="@" Q
37KILL 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
38 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
39 Q
Note: See TracBrowser for help on using the repository browser.