Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRACM2F

LRACM2F.m

Go to the documentation of this file.
  1. LRACM2F ;MILW/JMC - LIST CUMULATIVE PATIENTS FOR SELECTED LOCATIONS ; 5/15/92
  1. ;;5.2;LAB SERVICE;**1**;Sep 27, 1994
  1. EN ;Print list of cumulative patients for range of locations.
  1. K ^TMP($J),%DT,LR,DIR,LRLLOC
  1. S (LR,LRALL,LREND)=0,Y=$P($G(^LAB(64.5,1,0)),U,3)
  1. I Y S Y=$$FMTE^XLFDT(Y),%DT("B")=Y W !,"Current Cumulative Report Date: ",Y,!
  1. S %DT="AEQ",%DT("A")="Select REPORT DATE: ",%DT(0)="-NOW" D ^%DT Q:Y<1
  1. S LRDT=Y,LRDT1=$$FMTE^XLFDT(Y)
  1. D HDR1
  1. S Y="",(LRI,X)=0
  1. F S Y=$O(^LRO(69,LRDT,1,"AR",Y)) Q:Y=""!(LREND) D
  1. . S LRI=LRI+1,^TMP($J,"LR",LRI)=Y W ?X,$J(LRI,4),?X+6,$E(Y,1,20) S X=X+25
  1. . I X=75 S X=0 W !
  1. . I $Y+3>IOSL D
  1. . . N X,Y S DIR(0)="E" D ^DIR K DIR I 'Y S LREND=1 Q
  1. . . D HDR1
  1. I 'LRI W "No patients for this day",! G END
  1. I LRI,'LREND S (LRI,LR)=LRI+1 W ?X,$J(LRI,4),?X+6,"ALL Locations"
  1. W !!
  1. S DIR(0)="LO^1:"_LRI,DIR("A")="Select LOCATIONS" D ^DIR K DIR
  1. I $D(DIRUT) G END
  1. S Z="",J=0
  1. F S Z=$O(Y(Z)) Q:Z=""!(LRALL) D
  1. . S X=Y(Z)
  1. . F XX=1:1 Q:'$P(X,",",XX)!(LRALL) D
  1. . . I $P(X,",",XX)=LR S LRALL=1 Q
  1. . . S ^TMP($J,"LRLLOC",^TMP($J,"LR",$P(X,",",XX)))="",J=J+1
  1. S ^TMP($J,"LRLLOC",0)=J
  1. I LRALL D
  1. . S (I,J)=0
  1. . F S I=$O(^TMP($J,"LR",I)) Q:'I S ^TMP($J,"LRLLOC",^TMP($J,"LR",I))="",J=J+1
  1. . S ^TMP($J,"LRLLOC",0)=J
  1. S %ZIS="Q" K IO("Q"),IO("C") D ^%ZIS Q:POP
  1. I $D(IO("Q")) D G END
  1. . S ZTRTN="DQ^LRACM2F",ZTDESC="Lab Cum Patient List"
  1. . S (ZTSAVE("LRALL"),ZTSAVE("LRDT"),ZTSAVE("LRDT1"),ZTSAVE("^TMP($J,""LRLLOC"","))=""
  1. . D ^%ZTLOAD W !,"Request ",$S($D(ZTSK):"",1:"NOT "),"Queued" K ZTSK
  1. . D ^%ZISC
  1. ;
  1. DQ ; Dequeue entry point.
  1. U IO
  1. S (LRCTRR,LRCTRR(0),LRCTRR(1),LREND,LRPG)=0
  1. S LRLINE="",$P(LRLINE,"-",IOM)="-",LRPDT=$$HTE^XLFDT($H)
  1. S LRCNT=^TMP($J,"LRLLOC",0) ; Count of number of locations selected
  1. D HDR
  1. S L=0
  1. F S L=$O(^TMP($J,"LRLLOC",L)) Q:L=""!(LREND) D
  1. . I $Y+10>IOSL D HDR Q:LREND
  1. . W !!," LOCATION: ",L,?43,"LRDFN",!
  1. . S P=""
  1. . F S P=$O(^LRO(69,LRDT,1,"AR",L,P)) Q:P=""!(LREND) D
  1. . . S LRDFN=0
  1. . . F S LRDFN=$O(^LRO(69,LRDT,1,"AR",L,P,LRDFN)) Q:'LRDFN!(LREND) D
  1. . . . I $Y+5>IOSL D HDR Q:LREND W !!," LOCATION: ",L," (Continued)",?43,"LRDFN",!
  1. . . . S X=^LR(LRDFN,0),LRDPF=$P(X,"^",2),DFN=$P(X,"^",3) D PT^LRX
  1. . . . S Y=^LRO(69,LRDT,1,"AR",L,P,LRDFN),LRCTRR=LRCTRR+1,LRCTRR(1)=LRCTRR(1)+Y
  1. . . . W !,LRCTRR,?5,$E(PNM,1,20),?28,SSN,?42,$J(LRDFN,6),?50,$S(Y:"Processed",1:"")
  1. . . . W ?61,"File: ",LRDPF,?72,$E(LRWRD,1,8)
  1. . S LRCTRR(0)=LRCTRR(0)+LRCTRR,LRCTRR=0
  1. I 'LREND D
  1. . I $Y+6>IOSL D HDR
  1. . W !!,"Totals for ",$S(LRALL:"'ALL'",1:"Selected")," Locations"
  1. . W !!,"Number of Patients: ",$J($FN(LRCTRR(0),","),5)
  1. . W !," Number Processed: ",$J($FN(LRCTRR(1),","),5)
  1. I $E(IOST,1,2)="P-" W @IOF
  1. ;
  1. END ; Clean up.
  1. K ^TMP($J)
  1. K LRI,%DT,J,L,LR,LRALL,LRCNT,LRLINE,LRLLOC,LRPDT,LRPRAC,P,X,XX,Z
  1. D END^LRACM
  1. D KVAR^LRX
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. E D ^%ZISC
  1. Q
  1. ;
  1. HDR ; Print header for report.
  1. I LRPG,'$D(ZTQUEUED),$E(IOST,1,2)="C-" D Q:LREND
  1. . F Q:$Y+3>IOSL W !
  1. . K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S LREND=1
  1. W:$Y @IOF
  1. S LRPG=LRPG+1
  1. W "List of Cumulative Patients for ",$S(LRALL:"'ALL'",1:"Selected")," Location",$S(LRCNT>1:"s",1:"")
  1. W:$X+32>IOM ! W ?IOM-32," Printed: ",LRPDT
  1. W !,"Report Date: ",LRDT1,?IOM-28,"Page: ",LRPG
  1. W !,"For Location",$S(LRCNT>1:"s",1:""),": "
  1. I LRALL W "'ALL'"
  1. E S X=0 F S X=$O(^TMP($J,"LRLLOC",X)) Q:X="" W:$X+$L(X)+3>IOM !,?17 W X,", "
  1. W !,LRLINE,!
  1. Q
  1. ;
  1. HDR1 ; Print header for display.
  1. W @IOF,"The following locations have patients for ",LRDT1,".",!!
  1. Q
  1. ;
  1. TASK ; Entry point for tasked option. Prints current report date for all locations.
  1. S LREND=0,LRALL=1
  1. S LRDT=$P($G(^LAB(64.5,1,0)),U,3) I 'LRDT G END ; No report date on file.
  1. S LRDT1=$$FMTE^XLFDT(LRDT)
  1. S Y="",LRI=0
  1. F S Y=$O(^LRO(69,LRDT,1,"AR",Y)) Q:Y="" S LRI=LRI+1,^TMP($J,"LRLLOC",Y)=Y
  1. I 'LRI G END ; No patients on report.
  1. S ^TMP($J,"LRLLOC",0)=LRI
  1. G DQ