source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRRS13.m@ 1150

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1LRRS13 ;SLC/DCM,BA/DALISC/FHS/DRH - INTERIM REPORT BY LOCATION (MANUAL QUEUE) ;2/19/91 11:39 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 ;EXTENSION OF LRRS12
4DQ ;dequeued
5 S LRHOLD=LRODT
6 S:$D(ZTQUEUED) ZTREQ="@" U IO D @$S(LRLOC="S":"IT",LRLOC="R":"IT",1:"ALL")
7END ;
8 D ^LRRK
9 K LRLOCXY,LRX1,LRY1,OK
10 Q
11CHKDAT ;
12 S LRHOLD=LRODT
13 S LRCHK=""
14 F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT=""!(LRODT>LRLAST) D
15 . I $O(^LRO(69,LRODT,1,"AL",LRCHK))="" D NORPT
16 S LRODT=LRHOLD K LRHOLD
17 Q
18IT ;
19 S LRHOLD=LRODT
20 S LRLLOC=""
21 F S LRLLOC=$O(LRLLOC(LRLLOC)) Q:LRLLOC=""!($G(LREND)) D
22 . S LRODT=LRDTXX-.5
23 . D BIG
24 . S LRANY=0
25 . F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT=""!(LRODT>LRLAST)!($G(LREND)) D
26 .. I $D(^LRO(69,LRODT,1,"AL",LRLLOC)) D PROCESS S LRANY=1
27 . I '$G(LRANY) D NORPT QUIT
28 Q
29NORPT ;
30 W !!!
31 W !?10,"No Reports from: ",LRLLOC," for this date range."
32 W @IOF
33 Q
34ALL ;
35 S LREND=0
36 S LRODT=LRDTXX-.5
37 F S LRODT=$O(^LRO(69,LRODT)) Q:+LRODT'>0!(LRODT>LRLAST)!($G(LREND)) D
38 . S LRLLOC="",LRANY=0
39 . F S LRLLOC=$O(^LRO(69,LRODT,1,"AL",LRLLOC)) Q:LRLLOC=""!($G(LREND)) D
40 .. D BIG,PROCESS S LRANY=1
41 Q:LRLLOC="" I '$G(LRANY) D NORPT QUIT
42 Q
43BIG ;
44 ;Q:$G(LRANY)
45 S LRXY98Z=1
46 S LRLTR=$S(LRLLOC="":"UNK",1:LRLLOC)
47 W !!
48 I $E(IOST,1,2)'="C-" D ^LRLTR
49 ;D ^LRLTR W @IOF
50 K LRXY98Z
51 Q
52PROCESS ;
53 S LREDT=9999999-LRODT,LRSDT=LRODT+.5
54 S LRJ0=1
55 D LNAME
56 Q:LREND
57 K LRHOLD
58 Q
59LNAME ;
60 Q:$G(LREND)
61 S LRNAME=""
62 F S LRNAME=$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME)) Q:LRNAME=""!($G(LREND)) D
63 . D PAT Q:LREND
64 Q
65PAT ;
66 Q:$G(LREND)
67 S LRDFN=0
68 F S LRDFN=+$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME,LRDFN)) Q:LRDFN<1!($G(LREND)) D
69 . S LRIDT=9999999-LRSDT D DS^LRRP2 S:LRSTOP LREND=1 Q:$G(LREND)
70 Q
71SINGLE ;from option LRRS BY LOC
72 S LRSINGLE=1,LRLOC="S" D BEGIN^LRRS12
73 Q
74SHOW ;Display possible choices of locations
75 W !?10,"Select from: " S I="",LREND=0 F A=0:0 S I=$O(^LRO(69,LRODT,1,"AL",I)) Q:I="" D:$Y>(IOSL-4) WAIT Q:LREND W ?25,I,!
76 K A S (LROK,LREND)=0 W ! Q
77WAIT R !!?10,"Press RETURN to continue or '^' to exit: ",X:DTIME S:'$T!($E(X)="^") LREND=1 Q:LREND
78 W @IOF,!!?10,"Select from: " Q
Note: See TracBrowser for help on using the repository browser.