source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRACM2F.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1LRACM2F ;MILW/JMC - LIST CUMULATIVE PATIENTS FOR SELECTED LOCATIONS ; 5/15/92
2 ;;5.2;LAB SERVICE;**1**;Sep 27, 1994
3EN ;Print list of cumulative patients for range of locations.
4 K ^TMP($J),%DT,LR,DIR,LRLLOC
5 S (LR,LRALL,LREND)=0,Y=$P($G(^LAB(64.5,1,0)),U,3)
6 I Y S Y=$$FMTE^XLFDT(Y),%DT("B")=Y W !,"Current Cumulative Report Date: ",Y,!
7 S %DT="AEQ",%DT("A")="Select REPORT DATE: ",%DT(0)="-NOW" D ^%DT Q:Y<1
8 S LRDT=Y,LRDT1=$$FMTE^XLFDT(Y)
9 D HDR1
10 S Y="",(LRI,X)=0
11 F S Y=$O(^LRO(69,LRDT,1,"AR",Y)) Q:Y=""!(LREND) D
12 . S LRI=LRI+1,^TMP($J,"LR",LRI)=Y W ?X,$J(LRI,4),?X+6,$E(Y,1,20) S X=X+25
13 . I X=75 S X=0 W !
14 . I $Y+3>IOSL D
15 . . N X,Y S DIR(0)="E" D ^DIR K DIR I 'Y S LREND=1 Q
16 . . D HDR1
17 I 'LRI W "No patients for this day",! G END
18 I LRI,'LREND S (LRI,LR)=LRI+1 W ?X,$J(LRI,4),?X+6,"ALL Locations"
19 W !!
20 S DIR(0)="LO^1:"_LRI,DIR("A")="Select LOCATIONS" D ^DIR K DIR
21 I $D(DIRUT) G END
22 S Z="",J=0
23 F S Z=$O(Y(Z)) Q:Z=""!(LRALL) D
24 . S X=Y(Z)
25 . F XX=1:1 Q:'$P(X,",",XX)!(LRALL) D
26 . . I $P(X,",",XX)=LR S LRALL=1 Q
27 . . S ^TMP($J,"LRLLOC",^TMP($J,"LR",$P(X,",",XX)))="",J=J+1
28 S ^TMP($J,"LRLLOC",0)=J
29 I LRALL D
30 . S (I,J)=0
31 . F S I=$O(^TMP($J,"LR",I)) Q:'I S ^TMP($J,"LRLLOC",^TMP($J,"LR",I))="",J=J+1
32 . S ^TMP($J,"LRLLOC",0)=J
33 S %ZIS="Q" K IO("Q"),IO("C") D ^%ZIS Q:POP
34 I $D(IO("Q")) D G END
35 . S ZTRTN="DQ^LRACM2F",ZTDESC="Lab Cum Patient List"
36 . S (ZTSAVE("LRALL"),ZTSAVE("LRDT"),ZTSAVE("LRDT1"),ZTSAVE("^TMP($J,""LRLLOC"","))=""
37 . D ^%ZTLOAD W !,"Request ",$S($D(ZTSK):"",1:"NOT "),"Queued" K ZTSK
38 . D ^%ZISC
39 ;
40DQ ; Dequeue entry point.
41 U IO
42 S (LRCTRR,LRCTRR(0),LRCTRR(1),LREND,LRPG)=0
43 S LRLINE="",$P(LRLINE,"-",IOM)="-",LRPDT=$$HTE^XLFDT($H)
44 S LRCNT=^TMP($J,"LRLLOC",0) ; Count of number of locations selected
45 D HDR
46 S L=0
47 F S L=$O(^TMP($J,"LRLLOC",L)) Q:L=""!(LREND) D
48 . I $Y+10>IOSL D HDR Q:LREND
49 . W !!," LOCATION: ",L,?43,"LRDFN",!
50 . S P=""
51 . F S P=$O(^LRO(69,LRDT,1,"AR",L,P)) Q:P=""!(LREND) D
52 . . S LRDFN=0
53 . . F S LRDFN=$O(^LRO(69,LRDT,1,"AR",L,P,LRDFN)) Q:'LRDFN!(LREND) D
54 . . . I $Y+5>IOSL D HDR Q:LREND W !!," LOCATION: ",L," (Continued)",?43,"LRDFN",!
55 . . . S X=^LR(LRDFN,0),LRDPF=$P(X,"^",2),DFN=$P(X,"^",3) D PT^LRX
56 . . . S Y=^LRO(69,LRDT,1,"AR",L,P,LRDFN),LRCTRR=LRCTRR+1,LRCTRR(1)=LRCTRR(1)+Y
57 . . . W !,LRCTRR,?5,$E(PNM,1,20),?28,SSN,?42,$J(LRDFN,6),?50,$S(Y:"Processed",1:"")
58 . . . W ?61,"File: ",LRDPF,?72,$E(LRWRD,1,8)
59 . S LRCTRR(0)=LRCTRR(0)+LRCTRR,LRCTRR=0
60 I 'LREND D
61 . I $Y+6>IOSL D HDR
62 . W !!,"Totals for ",$S(LRALL:"'ALL'",1:"Selected")," Locations"
63 . W !!,"Number of Patients: ",$J($FN(LRCTRR(0),","),5)
64 . W !," Number Processed: ",$J($FN(LRCTRR(1),","),5)
65 I $E(IOST,1,2)="P-" W @IOF
66 ;
67END ; Clean up.
68 K ^TMP($J)
69 K LRI,%DT,J,L,LR,LRALL,LRCNT,LRLINE,LRLLOC,LRPDT,LRPRAC,P,X,XX,Z
70 D END^LRACM
71 D KVAR^LRX
72 I $D(ZTQUEUED) S ZTREQ="@"
73 E D ^%ZISC
74 Q
75 ;
76HDR ; Print header for report.
77 I LRPG,'$D(ZTQUEUED),$E(IOST,1,2)="C-" D Q:LREND
78 . F Q:$Y+3>IOSL W !
79 . K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S LREND=1
80 W:$Y @IOF
81 S LRPG=LRPG+1
82 W "List of Cumulative Patients for ",$S(LRALL:"'ALL'",1:"Selected")," Location",$S(LRCNT>1:"s",1:"")
83 W:$X+32>IOM ! W ?IOM-32," Printed: ",LRPDT
84 W !,"Report Date: ",LRDT1,?IOM-28,"Page: ",LRPG
85 W !,"For Location",$S(LRCNT>1:"s",1:""),": "
86 I LRALL W "'ALL'"
87 E S X=0 F S X=$O(^TMP($J,"LRLLOC",X)) Q:X="" W:$X+$L(X)+3>IOM !,?17 W X,", "
88 W !,LRLINE,!
89 Q
90 ;
91HDR1 ; Print header for display.
92 W @IOF,"The following locations have patients for ",LRDT1,".",!!
93 Q
94 ;
95TASK ; Entry point for tasked option. Prints current report date for all locations.
96 S LREND=0,LRALL=1
97 S LRDT=$P($G(^LAB(64.5,1,0)),U,3) I 'LRDT G END ; No report date on file.
98 S LRDT1=$$FMTE^XLFDT(LRDT)
99 S Y="",LRI=0
100 F S Y=$O(^LRO(69,LRDT,1,"AR",Y)) Q:Y="" S LRI=LRI+1,^TMP($J,"LRLLOC",Y)=Y
101 I 'LRI G END ; No patients on report.
102 S ^TMP($J,"LRLLOC",0)=LRI
103 G DQ
Note: See TracBrowser for help on using the repository browser.