source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRACM1.m@ 776

Last change on this file since 776 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1LRACM1 ;SLC/DCM - MENU FOR CUMULATIVE REPORTS CONT. ;2/20/91 08:36 ;
2 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
3END D A D:LRNOT MSG^LRACM D LOOP,END^LRACM Q
4LOOP D ASK S LRRE=1 K X1
5 S DIC("A")="START WITH " D DIC Q:LRLLOC<0!(".^"[LRLLOC) I '$D(^LRO(69,LRDT,1,"AR",LRLLOC)) W $C(7),!!,"NO DATA IN THE CROSS-REFERENCE FOR THIS LOCATION!" Q
6 K ^TMP($J,"LRIF") S:$D(L(X)) X1=X S LRPPT="",LRIF=0
7 F S LRPPT=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRPPT)) Q:LRPPT="" S LRDFN=0 F S LRDFN=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRPPT,LRDFN)) Q:LRDFN<1 S LRIF=LRIF+1,^TMP($J,"LRIF",LRIF)=$S(LRLLOC'["FILE ROOM":LRPPT,1:$P(^(LRDFN),U,2)_U_LRPPT)
8N W ! F I=1:1:LRIF W:I#2 ! W:'(I#2) ?40 W I_"."_" ",$P(^TMP($J,"LRIF",I),U,1)
9NUM R !!,"Start with patient #: ",X:DTIME Q:".^"[X G:X["?" N G:X'?.N!(X>LRIF)!(X<1) NUM S LRNM=^TMP($J,"LRIF",X),X2=X,LRNM=$S(LRLLOC'["FILE ROOM":$P(LRNM,U,1),1:$P(LRNM,U,2))
10 S K=-1 F I=0:0 S K=$O(^LRO(69,LRDT,1,"AR",K)) Q:K="" S LREN=K
11LRLOCA S LRLOCA=LRLLOC,DIC("A")="END WITH " D DIC Q:LRLLOC<0!(".^"[LRLLOC) I $D(L(X)),X1>X K X1
12 I '$D(^LRO(69,LRDT,1,"AR",LRLLOC)) W $C(7),!!,"NO DATA IN THE CROSS-REFERENCE FOR THIS LOCATION!" Q
13 K:LREN=LRLLOC LREN S LRPPT="" G:LRLLOC=LRLOCA N1 S LRIF=0
14 F S LRPPT=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRPPT)) Q:LRPPT="" S LRDFN=0 F S LRDFN=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRPPT,LRDFN)) Q:LRDFN<1 S LRIF=LRIF+1,^TMP($J,"LRIF",LRIF)=$S(LRLLOC'["FILE ROOM":LRPPT,1:$P(^(LRDFN),U,2)_U_LRPPT)
15N1 W ! F I=1:1:LRIF W:I#2 ! W:'(I#2) ?40 W I_"."_" ",$P(^TMP($J,"LRIF",I),U,1)
16NUM1 R !!,"End with patient #: ",X:DTIME Q:".^"[X G:X["?" N1 G:X'?.NP!(X>LRIF)!(X<1) NUM1 S LRNMA=^TMP($J,"LRIF",X),LRNMA=$S(LRLLOC'["FILE ROOM":$P(LRNMA,U,1),1:$P(LRNMA,U,2))
17 I LRLLOC=LRLOCA,X2>X S X=LRNM,LRNM=LRNMA,LRNMA=X
18 I '$D(X1) S X=LRLLOC,LRLLOC=LRLOCA,LRLOCA=X,X=LRNM,LRNM=LRNMA,LRNMA=X
19 S LRLOCB=LRLLOC,LRLLOC=LRLOCA,LRSUB=0,LRDFN=0
20 K IO("Q") S %ZIS="QM" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="END1^LRACM1",ZTSAVE("DT")="",ZTSAVE("DUZ")="",ZTSAVE("LR*")="",ZTSAVE("U")="" D ^%ZTLOAD D ^%ZISC K ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK Q
21 U IO
22END1 K X2 S:$D(ZTQUEUED) ZTREQ="@" S LRTRUE=1
23 D ENT^LRAC1
24 K LREN,LRRE,LRAC,LRLOCA,LRLOCB,LRNMA,LRTRUE D END^LRACM Q
25EN ;
26DIC S LRLLOC="",Y=LRDT S Y=$$Y2K^LRX(Y) W !!," LOCATION LIST OF CUMULATIVE FOR ",Y S L="" F I=1:1 S L=$O(^LRO(69,LRDT,1,"AR",L)) Q:L="" W:I#2 ! W:'(I#2) ?40 W I_"."_" ",L S L(I)=L
27 I $D(L)'=11 W " is empty." Q
28 W !,DIC("A") R "LOCATION #: ",X:DTIME Q:"^."[X G:X'?.NP!(X>I)!(X<1) DIC
29 I '$D(L(X)) W !,$C(7),"LOCATION NOT DEFINED!" G DIC
30 S LRLLOC=L(X)
31DIC1 K DIC
32 Q
33 K ZTSK S LRYDT=DT,LRRE=1
34 S Y=$P(^LAB(64.5,1,0),U,3) S Y=$$Y2K^LRX(Y) W !!,"Last run: ",Y
35 Q
36A ;from LRACM, LRACM3
37 S LRNOT=0
38 S LRIG=0 F S LRIG=$O(^LAB(64.5,1,3,LRIG)) Q:LRIG<1 I '$L($P(^(LRIG,0),U,8)) S LRNOT=1 Q
39 I LRNOT W !,"DO NOT try to reprint reports that have not finished!",!
40 K X2,LRIG Q
41ASK ;from LRACM, LRACM3
42 S LRDT=$P(^LAB(64.5,1,0),U,3),LRXLR="LRAC",LRBOT=$P(^LAB(64.5,1,0),U,2),LRPERM=0 D DT^LRX S Y=$$Y2K^LRX(DT) S LRCDT=Y I LRDT="" S X="T-1",%DT="" D ^%DT S LRDT=Y
43 K ZTSK S LRYDT=DT,LRRE=1
44 S Y=$P(^LAB(64.5,1,0),U,3) S Y=$$Y2K^LRX(Y) W !!,"Last run: ",Y
45 Q
Note: See TracBrowser for help on using the repository browser.