source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRRS.m@ 1487

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1LRRS ;SLC/DCM/BA/DALOI/FHS - INTERIM REPORT BY LOCATION (MANUAL QUEUE) ;2/19/91 11:39
2 ;;5.2;LAB SERVICE;**283,337**;Sep 27, 1994;Build 2
3 ;from option LRRS
4BEGIN D:'$D(LRPARAM) ^LRPARAM G:$G(LREND) ^LRRK Q:$G(LREND) S:'$D(LRSINGLE) LRSINGLE=0 S:'$D(LRPRTPG) LRPRTPG=0 D LOC
5END D ^LRRK
6 Q
7CUM ;ENTRY POINT FOR CUMULATIVE OPTION LRAC LOC-LOC
8 S LRPRTPG=1
9 D BEGIN
10 Q
11LOC K LRLLOC
12 S (LREND,LRSTOP)=0,(LRONETST,LRONESPC,LRLLOC,LRFLOC)="",LRELOC="ZZZZZZZZ",LRLAB=$S($D(LRLABKY):1,1:0) K DIC
13 K %DT S %DT("A")="DAILY REPORT FOR DAY: ",%DT="EQ" D DATE^LRWU Q:Y<1 K %DT S LRODT=Y,LRSDT=LRODT+.5,LREDT=9999999-LRODT
14 I $O(^LRO(69,LRODT,1,"AL",0))="" W !!?10,"No Reports for [ ",$$DTF^LRAFUNC1(LRODT),"] ",!! Q
15 I 'LRSINGLE F R !,"Do you want (A)ll locations, a (R)ange of locations,",!,"or (S)elected locations? S// ",X:DTIME S:X="" X="S" Q:$L(X)=1&("ARS^"[X) W !,"Enter 'A', 'R', 'S' or '^' to exit"
16 I 'LRSINGLE Q:X[U S LRLOC=X
17ASKPG I 'LRPRTPG D
18 .S DIR(0)="Y",DIR("A")="Print address page",DIR("B")="NO"
19 .D ^DIR K DIR
20 .I Y S LRPRTPG=1
21 D @$S(LRLOC="S":"SELECT",LRLOC="R":"RANGE",1:"QUE")
22 Q
23SELECT N LRLOCX,DIC,LRCNT
24 W !! D AL
25 Q:$G(LREND)
26 I $O(LRLLOC(0))="" W !!?7,"NOTHING SELECTED ",! Q
27 D QUE
28 Q
29AL ;
30 S (LRCNT,LRLOCX,LREND)=""
31 F S LRLOCX=$O(^LRO(69,LRODT,1,"AL",LRLOCX)) Q:LRLOCX="" S LRCNT=LRCNT+1,LRLOCX(LRLOCX)=""
32 I 'LRCNT W !,"No Reports for ",$$DTF^LRAFUNC1(LRODT),! Q
33 S DIC=44,DIC("S")="I $L($P(^(0),U,2)),$D(LRLOCX($P(^(0),U,2)))",DIC(0)="QEZNM"
34AL0 R !,"Select Report Location: ",X:DTIME S:'$T!($E(X)="^") LREND=1 Q:X=""
35 Q:$G(LREND)
36 I $D(LRLOCX(X)) S LRLLOC(X)="" G AL0
37SELLOC D ^DIC G:Y<1 AL0
38 S Y1=$P(Y(0),U,2)
39 S:$D(LRLOCX(Y1)) LRLLOC(Y1)=""
40 Q:$D(DUOUT)
41 K DIC
42 G AL0
43 Q
44DIS ;
45 N I
46 F I=1:1:LRCNT W !,I,?4,LRLOCX(I) S I=I+1 Q:I>LRCNT W:$D(LRLOCX(I)) ?39," ",I,?44,LRLOCX(I)
47 W ! Q
48 Q
49RANGE W !,"Select STARTING PATIENT LOCATION: " R X:DTIME S:X="" X="^"
50 I X["?" W !,"Enter the first patient location (abbreviation) that you want." G RANGE
51 S:X="ALL"!(X="all") X="" S LRLLOC=X S LRFLOC=$S(LRLLOC="^":"",1:$E(LRLLOC,1,$L(LRLLOC)-1)_$C($A($E(LRLLOC,$L(LRLLOC)))-1))
52RANGE2 W !,"Select ENDING LOCATION: " R X:DTIME S:X="" X="^"
53 I X["?" W !,"Enter the last patient location (abbreviation) that you want." G RANGE2
54 S:X="ALL"!(X="all") X="" S LRLLOC=X Q:LRLLOC="^" S LRELOC=$E(LRLLOC,1,15)
55QUE S %ZIS="MQ",ZTRTN="DQ^LRRS" D IO^LRWU
56 Q
57DQ ;dequeued
58 S:$D(ZTQUEUED) ZTREQ="@" U IO D @$S(LRLOC="S":"SEL",1:"RNG")
59 Q
60SEL ;
61 S LRLLOC="",LRJ0=1
62 F S LRLLOC=$O(LRLLOC(LRLLOC)) Q:LRLLOC="" W:'LRJ0 @IOF S LRLTR=LRLLOC D:$E(IOST,1,2)'="C-" ^LRLTR D LNAME S LRJ0=0 Q:LREND
63 W @IOF
64 Q
65RNG ;
66 S LRJ0=1
67 F S LRLLOC=$O(^LRO(69,LRODT,1,"AL",LRFLOC)) Q:LREND!(LRLLOC="")!(LRLLOC]LRELOC) D
68 .S LRFLOC=LRLLOC
69 .W:'LRJ0 @IOF
70 .S LRLTR=$S(LRLLOC="":"UNK",1:LRLLOC)
71 .D:$E(IOST,1,2)'="C-" ^LRLTR
72 .D LNAME
73 .Q:LREND
74 W @IOF
75 Q
76LNAME S LRNAME="" F S LRNAME=$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME)) Q:LRNAME="" D PAT Q:LREND
77 Q
78PAT S LRDFN=0 F S LRDFN=+$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME,LRDFN)) Q:LRDFN<1 S LRIDT=9999999-LRSDT D DS^LRRP2 S:LRSTOP LREND=1 Q:LREND
79 S LRJ0=0
80 Q
81CUMSGLE ;ENTRY POINT FOR OPTION LRAC LOC
82 S LRPRTPG=1
83SINGLE ;from option LRRS BY LOC
84 S LRSINGLE=1,LRLOC="S" D BEGIN
85 Q
86SHOW ;Display possible choices of locations
87 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,!
88 K A S (LROK,LREND)=0 W ! Q
89WAIT R !!?10,"Press RETURN to continue or '^' to exit: ",X:DTIME S:'$T!($E(X)="^") LREND=1 Q:LREND
90 W @IOF,!!?10,"Select from: " Q
Note: See TracBrowser for help on using the repository browser.