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