LRACM2F ;MILW/JMC - LIST CUMULATIVE PATIENTS FOR SELECTED LOCATIONS ; 5/15/92
;;5.2;LAB SERVICE;**1**;Sep 27, 1994
EN ;Print list of cumulative patients for range of locations.
K ^TMP($J),%DT,LR,DIR,LRLLOC
S (LR,LRALL,LREND)=0,Y=$P($G(^LAB(64.5,1,0)),U,3)
I Y S Y=$$FMTE^XLFDT(Y),%DT("B")=Y W !,"Current Cumulative Report Date: ",Y,!
S %DT="AEQ",%DT("A")="Select REPORT DATE: ",%DT(0)="-NOW" D ^%DT Q:Y<1
S LRDT=Y,LRDT1=$$FMTE^XLFDT(Y)
D HDR1
S Y="",(LRI,X)=0
F S Y=$O(^LRO(69,LRDT,1,"AR",Y)) Q:Y=""!(LREND) D
. S LRI=LRI+1,^TMP($J,"LR",LRI)=Y W ?X,$J(LRI,4),?X+6,$E(Y,1,20) S X=X+25
. I X=75 S X=0 W !
. I $Y+3>IOSL D
. . N X,Y S DIR(0)="E" D ^DIR K DIR I 'Y S LREND=1 Q
. . D HDR1
I 'LRI W "No patients for this day",! G END
I LRI,'LREND S (LRI,LR)=LRI+1 W ?X,$J(LRI,4),?X+6,"ALL Locations"
W !!
S DIR(0)="LO^1:"_LRI,DIR("A")="Select LOCATIONS" D ^DIR K DIR
I $D(DIRUT) G END
S Z="",J=0
F S Z=$O(Y(Z)) Q:Z=""!(LRALL) D
. S X=Y(Z)
. F XX=1:1 Q:'$P(X,",",XX)!(LRALL) D
. . I $P(X,",",XX)=LR S LRALL=1 Q
. . S ^TMP($J,"LRLLOC",^TMP($J,"LR",$P(X,",",XX)))="",J=J+1
S ^TMP($J,"LRLLOC",0)=J
I LRALL D
. S (I,J)=0
. F S I=$O(^TMP($J,"LR",I)) Q:'I S ^TMP($J,"LRLLOC",^TMP($J,"LR",I))="",J=J+1
. S ^TMP($J,"LRLLOC",0)=J
S %ZIS="Q" K IO("Q"),IO("C") D ^%ZIS Q:POP
I $D(IO("Q")) D G END
. S ZTRTN="DQ^LRACM2F",ZTDESC="Lab Cum Patient List"
. S (ZTSAVE("LRALL"),ZTSAVE("LRDT"),ZTSAVE("LRDT1"),ZTSAVE("^TMP($J,""LRLLOC"","))=""
. D ^%ZTLOAD W !,"Request ",$S($D(ZTSK):"",1:"NOT "),"Queued" K ZTSK
. D ^%ZISC
;
DQ ; Dequeue entry point.
U IO
S (LRCTRR,LRCTRR(0),LRCTRR(1),LREND,LRPG)=0
S LRLINE="",$P(LRLINE,"-",IOM)="-",LRPDT=$$HTE^XLFDT($H)
S LRCNT=^TMP($J,"LRLLOC",0) ; Count of number of locations selected
D HDR
S L=0
F S L=$O(^TMP($J,"LRLLOC",L)) Q:L=""!(LREND) D
. I $Y+10>IOSL D HDR Q:LREND
. W !!," LOCATION: ",L,?43,"LRDFN",!
. S P=""
. F S P=$O(^LRO(69,LRDT,1,"AR",L,P)) Q:P=""!(LREND) D
. . S LRDFN=0
. . F S LRDFN=$O(^LRO(69,LRDT,1,"AR",L,P,LRDFN)) Q:'LRDFN!(LREND) D
. . . I $Y+5>IOSL D HDR Q:LREND W !!," LOCATION: ",L," (Continued)",?43,"LRDFN",!
. . . S X=^LR(LRDFN,0),LRDPF=$P(X,"^",2),DFN=$P(X,"^",3) D PT^LRX
. . . S Y=^LRO(69,LRDT,1,"AR",L,P,LRDFN),LRCTRR=LRCTRR+1,LRCTRR(1)=LRCTRR(1)+Y
. . . W !,LRCTRR,?5,$E(PNM,1,20),?28,SSN,?42,$J(LRDFN,6),?50,$S(Y:"Processed",1:"")
. . . W ?61,"File: ",LRDPF,?72,$E(LRWRD,1,8)
. S LRCTRR(0)=LRCTRR(0)+LRCTRR,LRCTRR=0
I 'LREND D
. I $Y+6>IOSL D HDR
. W !!,"Totals for ",$S(LRALL:"'ALL'",1:"Selected")," Locations"
. W !!,"Number of Patients: ",$J($FN(LRCTRR(0),","),5)
. W !," Number Processed: ",$J($FN(LRCTRR(1),","),5)
I $E(IOST,1,2)="P-" W @IOF
;
END ; Clean up.
K ^TMP($J)
K LRI,%DT,J,L,LR,LRALL,LRCNT,LRLINE,LRLLOC,LRPDT,LRPRAC,P,X,XX,Z
D END^LRACM
D KVAR^LRX
I $D(ZTQUEUED) S ZTREQ="@"
E D ^%ZISC
Q
;
HDR ; Print header for report.
I LRPG,'$D(ZTQUEUED),$E(IOST,1,2)="C-" D Q:LREND
. F Q:$Y+3>IOSL W !
. K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S LREND=1
W:$Y @IOF
S LRPG=LRPG+1
W "List of Cumulative Patients for ",$S(LRALL:"'ALL'",1:"Selected")," Location",$S(LRCNT>1:"s",1:"")
W:$X+32>IOM ! W ?IOM-32," Printed: ",LRPDT
W !,"Report Date: ",LRDT1,?IOM-28,"Page: ",LRPG
W !,"For Location",$S(LRCNT>1:"s",1:""),": "
I LRALL W "'ALL'"
E S X=0 F S X=$O(^TMP($J,"LRLLOC",X)) Q:X="" W:$X+$L(X)+3>IOM !,?17 W X,", "
W !,LRLINE,!
Q
;
HDR1 ; Print header for display.
W @IOF,"The following locations have patients for ",LRDT1,".",!!
Q
;
TASK ; Entry point for tasked option. Prints current report date for all locations.
S LREND=0,LRALL=1
S LRDT=$P($G(^LAB(64.5,1,0)),U,3) I 'LRDT G END ; No report date on file.
S LRDT1=$$FMTE^XLFDT(LRDT)
S Y="",LRI=0
F S Y=$O(^LRO(69,LRDT,1,"AR",Y)) Q:Y="" S LRI=LRI+1,^TMP($J,"LRLLOC",Y)=Y
I 'LRI G END ; No patients on report.
S ^TMP($J,"LRLLOC",0)=LRI
G DQ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRACM2F 3962 printed Apr 09, 2024@21:06:41 Page 2
LRACM2F ;MILW/JMC - LIST CUMULATIVE PATIENTS FOR SELECTED LOCATIONS ; 5/15/92
+1 ;;5.2;LAB SERVICE;**1**;Sep 27, 1994
EN ;Print list of cumulative patients for range of locations.
+1 KILL ^TMP($JOB),%DT,LR,DIR,LRLLOC
+2 SET (LR,LRALL,LREND)=0
SET Y=$PIECE($GET(^LAB(64.5,1,0)),U,3)
+3 IF Y
SET Y=$$FMTE^XLFDT(Y)
SET %DT("B")=Y
WRITE !,"Current Cumulative Report Date: ",Y,!
+4 SET %DT="AEQ"
SET %DT("A")="Select REPORT DATE: "
SET %DT(0)="-NOW"
DO ^%DT
if Y<1
QUIT
+5 SET LRDT=Y
SET LRDT1=$$FMTE^XLFDT(Y)
+6 DO HDR1
+7 SET Y=""
SET (LRI,X)=0
+8 FOR
SET Y=$ORDER(^LRO(69,LRDT,1,"AR",Y))
if Y=""!(LREND)
QUIT
Begin DoDot:1
+9 SET LRI=LRI+1
SET ^TMP($JOB,"LR",LRI)=Y
WRITE ?X,$JUSTIFY(LRI,4),?X+6,$EXTRACT(Y,1,20)
SET X=X+25
+10 IF X=75
SET X=0
WRITE !
+11 IF $Y+3>IOSL
Begin DoDot:2
+12 NEW X,Y
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET LREND=1
QUIT
+13 DO HDR1
End DoDot:2
End DoDot:1
+14 IF 'LRI
WRITE "No patients for this day",!
GOTO END
+15 IF LRI
IF 'LREND
SET (LRI,LR)=LRI+1
WRITE ?X,$JUSTIFY(LRI,4),?X+6,"ALL Locations"
+16 WRITE !!
+17 SET DIR(0)="LO^1:"_LRI
SET DIR("A")="Select LOCATIONS"
DO ^DIR
KILL DIR
+18 IF $DATA(DIRUT)
GOTO END
+19 SET Z=""
SET J=0
+20 FOR
SET Z=$ORDER(Y(Z))
if Z=""!(LRALL)
QUIT
Begin DoDot:1
+21 SET X=Y(Z)
+22 FOR XX=1:1
if '$PIECE(X,",",XX)!(LRALL)
QUIT
Begin DoDot:2
+23 IF $PIECE(X,",",XX)=LR
SET LRALL=1
QUIT
+24 SET ^TMP($JOB,"LRLLOC",^TMP($JOB,"LR",$PIECE(X,",",XX)))=""
SET J=J+1
End DoDot:2
End DoDot:1
+25 SET ^TMP($JOB,"LRLLOC",0)=J
+26 IF LRALL
Begin DoDot:1
+27 SET (I,J)=0
+28 FOR
SET I=$ORDER(^TMP($JOB,"LR",I))
if 'I
QUIT
SET ^TMP($JOB,"LRLLOC",^TMP($JOB,"LR",I))=""
SET J=J+1
+29 SET ^TMP($JOB,"LRLLOC",0)=J
End DoDot:1
+30 SET %ZIS="Q"
KILL IO("Q"),IO("C")
DO ^%ZIS
if POP
QUIT
+31 IF $DATA(IO("Q"))
Begin DoDot:1
+32 SET ZTRTN="DQ^LRACM2F"
SET ZTDESC="Lab Cum Patient List"
+33 SET (ZTSAVE("LRALL"),ZTSAVE("LRDT"),ZTSAVE("LRDT1"),ZTSAVE("^TMP($J,""LRLLOC"","))=""
+34 DO ^%ZTLOAD
WRITE !,"Request ",$SELECT($DATA(ZTSK):"",1:"NOT "),"Queued"
KILL ZTSK
+35 DO ^%ZISC
End DoDot:1
GOTO END
+36 ;
DQ ; Dequeue entry point.
+1 USE IO
+2 SET (LRCTRR,LRCTRR(0),LRCTRR(1),LREND,LRPG)=0
+3 SET LRLINE=""
SET $PIECE(LRLINE,"-",IOM)="-"
SET LRPDT=$$HTE^XLFDT($HOROLOG)
+4 ; Count of number of locations selected
SET LRCNT=^TMP($JOB,"LRLLOC",0)
+5 DO HDR
+6 SET L=0
+7 FOR
SET L=$ORDER(^TMP($JOB,"LRLLOC",L))
if L=""!(LREND)
QUIT
Begin DoDot:1
+8 IF $Y+10>IOSL
DO HDR
if LREND
QUIT
+9 WRITE !!," LOCATION: ",L,?43,"LRDFN",!
+10 SET P=""
+11 FOR
SET P=$ORDER(^LRO(69,LRDT,1,"AR",L,P))
if P=""!(LREND)
QUIT
Begin DoDot:2
+12 SET LRDFN=0
+13 FOR
SET LRDFN=$ORDER(^LRO(69,LRDT,1,"AR",L,P,LRDFN))
if 'LRDFN!(LREND)
QUIT
Begin DoDot:3
+14 IF $Y+5>IOSL
DO HDR
if LREND
QUIT
WRITE !!," LOCATION: ",L," (Continued)",?43,"LRDFN",!
+15 SET X=^LR(LRDFN,0)
SET LRDPF=$PIECE(X,"^",2)
SET DFN=$PIECE(X,"^",3)
DO PT^LRX
+16 SET Y=^LRO(69,LRDT,1,"AR",L,P,LRDFN)
SET LRCTRR=LRCTRR+1
SET LRCTRR(1)=LRCTRR(1)+Y
+17 WRITE !,LRCTRR,?5,$EXTRACT(PNM,1,20),?28,SSN,?42,$JUSTIFY(LRDFN,6),?50,$SELECT(Y:"Processed",1:"")
+18 WRITE ?61,"File: ",LRDPF,?72,$EXTRACT(LRWRD,1,8)
End DoDot:3
End DoDot:2
+19 SET LRCTRR(0)=LRCTRR(0)+LRCTRR
SET LRCTRR=0
End DoDot:1
+20 IF 'LREND
Begin DoDot:1
+21 IF $Y+6>IOSL
DO HDR
+22 WRITE !!,"Totals for ",$SELECT(LRALL:"'ALL'",1:"Selected")," Locations"
+23 WRITE !!,"Number of Patients: ",$JUSTIFY($FNUMBER(LRCTRR(0),","),5)
+24 WRITE !," Number Processed: ",$JUSTIFY($FNUMBER(LRCTRR(1),","),5)
End DoDot:1
+25 IF $EXTRACT(IOST,1,2)="P-"
WRITE @IOF
+26 ;
END ; Clean up.
+1 KILL ^TMP($JOB)
+2 KILL LRI,%DT,J,L,LR,LRALL,LRCNT,LRLINE,LRLLOC,LRPDT,LRPRAC,P,X,XX,Z
+3 DO END^LRACM
+4 DO KVAR^LRX
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 IF '$TEST
DO ^%ZISC
+7 QUIT
+8 ;
HDR ; Print header for report.
+1 IF LRPG
IF '$DATA(ZTQUEUED)
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+2 FOR
if $Y+3>IOSL
QUIT
WRITE !
+3 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET LREND=1
End DoDot:1
if LREND
QUIT
+4 if $Y
WRITE @IOF
+5 SET LRPG=LRPG+1
+6 WRITE "List of Cumulative Patients for ",$SELECT(LRALL:"'ALL'",1:"Selected")," Location",$SELECT(LRCNT>1:"s",1:"")
+7 if $X+32>IOM
WRITE !
WRITE ?IOM-32," Printed: ",LRPDT
+8 WRITE !,"Report Date: ",LRDT1,?IOM-28,"Page: ",LRPG
+9 WRITE !,"For Location",$SELECT(LRCNT>1:"s",1:""),": "
+10 IF LRALL
WRITE "'ALL'"
+11 IF '$TEST
SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"LRLLOC",X))
if X=""
QUIT
if $X+$LENGTH(X)+3>IOM
WRITE !,?17
WRITE X,", "
+12 WRITE !,LRLINE,!
+13 QUIT
+14 ;
HDR1 ; Print header for display.
+1 WRITE @IOF,"The following locations have patients for ",LRDT1,".",!!
+2 QUIT
+3 ;
TASK ; Entry point for tasked option. Prints current report date for all locations.
+1 SET LREND=0
SET LRALL=1
+2 ; No report date on file.
SET LRDT=$PIECE($GET(^LAB(64.5,1,0)),U,3)
IF 'LRDT
GOTO END
+3 SET LRDT1=$$FMTE^XLFDT(LRDT)
+4 SET Y=""
SET LRI=0
+5 FOR
SET Y=$ORDER(^LRO(69,LRDT,1,"AR",Y))
if Y=""
QUIT
SET LRI=LRI+1
SET ^TMP($JOB,"LRLLOC",Y)=Y
+6 ; No patients on report.
IF 'LRI
GOTO END
+7 SET ^TMP($JOB,"LRLLOC",0)=LRI
+8 GOTO DQ
