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