LRACM1 ;SLC/DCM - MENU FOR CUMULATIVE REPORTS CONT. ;2/20/91 08:36 ;
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
END D A D:LRNOT MSG^LRACM D LOOP,END^LRACM Q
LOOP D ASK S LRRE=1 K X1
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
K ^TMP($J,"LRIF") S:$D(L(X)) X1=X S LRPPT="",LRIF=0
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)
N W ! F I=1:1:LRIF W:I#2 ! W:'(I#2) ?40 W I_"."_" ",$P(^TMP($J,"LRIF",I),U,1)
NUM 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))
S K=-1 F I=0:0 S K=$O(^LRO(69,LRDT,1,"AR",K)) Q:K="" S LREN=K
LRLOCA S LRLOCA=LRLLOC,DIC("A")="END WITH " D DIC Q:LRLLOC<0!(".^"[LRLLOC) I $D(L(X)),X1>X K X1
I '$D(^LRO(69,LRDT,1,"AR",LRLLOC)) W $C(7),!!,"NO DATA IN THE CROSS-REFERENCE FOR THIS LOCATION!" Q
K:LREN=LRLLOC LREN S LRPPT="" G:LRLLOC=LRLOCA N1 S LRIF=0
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)
N1 W ! F I=1:1:LRIF W:I#2 ! W:'(I#2) ?40 W I_"."_" ",$P(^TMP($J,"LRIF",I),U,1)
NUM1 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))
I LRLLOC=LRLOCA,X2>X S X=LRNM,LRNM=LRNMA,LRNMA=X
I '$D(X1) S X=LRLLOC,LRLLOC=LRLOCA,LRLOCA=X,X=LRNM,LRNM=LRNMA,LRNMA=X
S LRLOCB=LRLLOC,LRLLOC=LRLOCA,LRSUB=0,LRDFN=0
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
U IO
END1 K X2 S:$D(ZTQUEUED) ZTREQ="@" S LRTRUE=1
D ENT^LRAC1
K LREN,LRRE,LRAC,LRLOCA,LRLOCB,LRNMA,LRTRUE D END^LRACM Q
EN ;
DIC 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
I $D(L)'=11 W " is empty." Q
W !,DIC("A") R "LOCATION #: ",X:DTIME Q:"^."[X G:X'?.NP!(X>I)!(X<1) DIC
I '$D(L(X)) W !,$C(7),"LOCATION NOT DEFINED!" G DIC
S LRLLOC=L(X)
DIC1 K DIC
Q
K ZTSK S LRYDT=DT,LRRE=1
S Y=$P(^LAB(64.5,1,0),U,3) S Y=$$Y2K^LRX(Y) W !!,"Last run: ",Y
Q
A ;from LRACM, LRACM3
S LRNOT=0
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
I LRNOT W !,"DO NOT try to reprint reports that have not finished!",!
K X2,LRIG Q
ASK ;from LRACM, LRACM3
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
K ZTSK S LRYDT=DT,LRRE=1
S Y=$P(^LAB(64.5,1,0),U,3) S Y=$$Y2K^LRX(Y) W !!,"Last run: ",Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRACM1 3184 printed Dec 13, 2024@02:06:24 Page 2
LRACM1 ;SLC/DCM - MENU FOR CUMULATIVE REPORTS CONT. ;2/20/91 08:36 ;
+1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
END DO A
if LRNOT
DO MSG^LRACM
DO LOOP
DO END^LRACM
QUIT
LOOP DO ASK
SET LRRE=1
KILL X1
+1 SET DIC("A")="START WITH "
DO DIC
if LRLLOC<0!(".^"[LRLLOC)
QUIT
IF '$DATA(^LRO(69,LRDT,1,"AR",LRLLOC))
WRITE $CHAR(7),!!,"NO DATA IN THE CROSS-REFERENCE FOR THIS LOCATION!"
QUIT
+2 KILL ^TMP($JOB,"LRIF")
if $DATA(L(X))
SET X1=X
SET LRPPT=""
SET LRIF=0
+3 FOR
SET LRPPT=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC,LRPPT))
if LRPPT=""
QUIT
SET LRDFN=0
FOR
SET LRDFN=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC,LRPPT,LRDFN))
if LRDFN<1
QUIT
SET LRIF=LRIF+1
SET ^TMP($JOB,"LRIF",LRIF)=$SELECT(LRLLOC'["FILE ROOM":LRPPT,1:$PIECE(^(LRDFN),U,2)_U_LRPPT)
N WRITE !
FOR I=1:1:LRIF
if I#2
WRITE !
if '(I#2)
WRITE ?40
WRITE I_"."_" ",$PIECE(^TMP($JOB,"LRIF",I),U,1)
NUM READ !!,"Start with patient #: ",X:DTIME
if ".^"[X
QUIT
if X["?"
GOTO N
if X'?.N!(X>LRIF)!(X<1)
GOTO NUM
SET LRNM=^TMP($JOB,"LRIF",X)
SET X2=X
SET LRNM=$SELECT(LRLLOC'["FILE ROOM":$PIECE(LRNM,U,1),1:$PIECE(LRNM,U,2))
+1 SET K=-1
FOR I=0:0
SET K=$ORDER(^LRO(69,LRDT,1,"AR",K))
if K=""
QUIT
SET LREN=K
LRLOCA SET LRLOCA=LRLLOC
SET DIC("A")="END WITH "
DO DIC
if LRLLOC<0!(".^"[LRLLOC)
QUIT
IF $DATA(L(X))
IF X1>X
KILL X1
+1 IF '$DATA(^LRO(69,LRDT,1,"AR",LRLLOC))
WRITE $CHAR(7),!!,"NO DATA IN THE CROSS-REFERENCE FOR THIS LOCATION!"
QUIT
+2 if LREN=LRLLOC
KILL LREN
SET LRPPT=""
if LRLLOC=LRLOCA
GOTO N1
SET LRIF=0
+3 FOR
SET LRPPT=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC,LRPPT))
if LRPPT=""
QUIT
SET LRDFN=0
FOR
SET LRDFN=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC,LRPPT,LRDFN))
if LRDFN<1
QUIT
SET LRIF=LRIF+1
SET ^TMP($JOB,"LRIF",LRIF)=$SELECT(LRLLOC'["FILE ROOM":LRPPT,1:$PIECE(^(LRDFN),U,2)_U_LRPPT)
N1 WRITE !
FOR I=1:1:LRIF
if I#2
WRITE !
if '(I#2)
WRITE ?40
WRITE I_"."_" ",$PIECE(^TMP($JOB,"LRIF",I),U,1)
NUM1 READ !!,"End with patient #: ",X:DTIME
if ".^"[X
QUIT
if X["?"
GOTO N1
if X'?.NP!(X>LRIF)!(X<1)
GOTO NUM1
SET LRNMA=^TMP($JOB,"LRIF",X)
SET LRNMA=$SELECT(LRLLOC'["FILE ROOM":$PIECE(LRNMA,U,1),1:$PIECE(LRNMA,U,2))
+1 IF LRLLOC=LRLOCA
IF X2>X
SET X=LRNM
SET LRNM=LRNMA
SET LRNMA=X
+2 IF '$DATA(X1)
SET X=LRLLOC
SET LRLLOC=LRLOCA
SET LRLOCA=X
SET X=LRNM
SET LRNM=LRNMA
SET LRNMA=X
+3 SET LRLOCB=LRLLOC
SET LRLLOC=LRLOCA
SET LRSUB=0
SET LRDFN=0
+4 KILL IO("Q")
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="END1^LRACM1"
SET ZTSAVE("DT")=""
SET ZTSAVE("DUZ")=""
SET ZTSAVE("LR*")=""
SET ZTSAVE("U")=""
DO ^%ZTLOAD
DO ^%ZISC
KILL ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK
QUIT
+5 USE IO
END1 KILL X2
if $DATA(ZTQUEUED)
SET ZTREQ="@"
SET LRTRUE=1
+1 DO ENT^LRAC1
+2 KILL LREN,LRRE,LRAC,LRLOCA,LRLOCB,LRNMA,LRTRUE
DO END^LRACM
QUIT
EN ;
DIC SET LRLLOC=""
SET Y=LRDT
SET Y=$$Y2K^LRX(Y)
WRITE !!," LOCATION LIST OF CUMULATIVE FOR ",Y
SET L=""
FOR I=1:1
SET L=$ORDER(^LRO(69,LRDT,1,"AR",L))
if L=""
QUIT
if I#2
WRITE !
if '(I#2)
WRITE ?40
WRITE I_"."_" ",L
SET L(I)=L
+1 IF $DATA(L)'=11
WRITE " is empty."
QUIT
+2 WRITE !,DIC("A")
READ "LOCATION #: ",X:DTIME
if "^."[X
QUIT
if X'?.NP!(X>I)!(X<1)
GOTO DIC
+3 IF '$DATA(L(X))
WRITE !,$CHAR(7),"LOCATION NOT DEFINED!"
GOTO DIC
+4 SET LRLLOC=L(X)
DIC1 KILL DIC
+1 QUIT
+2 KILL ZTSK
SET LRYDT=DT
SET LRRE=1
+3 SET Y=$PIECE(^LAB(64.5,1,0),U,3)
SET Y=$$Y2K^LRX(Y)
WRITE !!,"Last run: ",Y
+4 QUIT
A ;from LRACM, LRACM3
+1 SET LRNOT=0
+2 SET LRIG=0
FOR
SET LRIG=$ORDER(^LAB(64.5,1,3,LRIG))
if LRIG<1
QUIT
IF '$LENGTH($PIECE(^(LRIG,0),U,8))
SET LRNOT=1
QUIT
+3 IF LRNOT
WRITE !,"DO NOT try to reprint reports that have not finished!",!
+4 KILL X2,LRIG
QUIT
ASK ;from LRACM, LRACM3
+1 SET LRDT=$PIECE(^LAB(64.5,1,0),U,3)
SET LRXLR="LRAC"
SET LRBOT=$PIECE(^LAB(64.5,1,0),U,2)
SET LRPERM=0
DO DT^LRX
SET Y=$$Y2K^LRX(DT)
SET LRCDT=Y
IF LRDT=""
SET X="T-1"
SET %DT=""
DO ^%DT
SET LRDT=Y
+2 KILL ZTSK
SET LRYDT=DT
SET LRRE=1
+3 SET Y=$PIECE(^LAB(64.5,1,0),U,3)
SET Y=$$Y2K^LRX(Y)
WRITE !!,"Last run: ",Y
+4 QUIT
