source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPR1.m@ 861

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1LRCAPR1 ;DALOI/PAC/FHS/JBM - WKLD REP GENERATOR-MAIN ;10/15/92 11:15
2 ;;5.2;LAB SERVICE;**263**;Sep 27, 1994
3GO ;
4 G TRIAL
5EN ;
6 K DIC,%DT,^TMP("LR",$J),LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC,LRLDIV
7 K LRSITSEL,DIR
8 S (LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLDIV,LRLOC,LREND)=0
9 S LRIOPAT=""
10 Q
11LRINST ;
12 S LRSITNUM=+$P($G(^XMB(1,1,"XUS")),U,17)
13 S LRSITE=$P($G(^DIC(4,LRSITNUM,0)),U) S:LRSITE="" LRSITE="UNKNOWN"
14 S LRSITSEL=0 K DIR S DIR(0)="S^Y:YES;N:NO"
15 S DIR("A")="Do you want to print a specific DIVISION?"
16 S DIR("?")="If you have a multi-divisional institution you might want to print a particular division, otherwise your report will reflect the whole instution which might not be what you have intended."
17 S DIR("B")="NO"
18 D ^DIR Q:$D(DUOUT)!($D(DTOUT))
19 I Y="N" Q
20 S DIC("A")="Select a Division:",DIC=4,DIC(0)="AEMQ"
21 F D ^DIC Q:Y=-1 S LRSITSEL=+Y,LRSITSEL(+Y)=$S($L($P($G(^DIC(4,+Y,0)),U)):$P(^(0),U),1:"ERROR"_Y)
22 Q
23TRIAL ; entry point for work load lookup
24 D EN,LRINST G:$D(DUOUT)!($D(DTOUT)) EXIT K DIR
25 D ACCN^LRCAPR1A G:Y<0 EXIT
26 D DATE^LRCAPR1A G:Y<0 EXIT S %=2
27 W !,"Do you want to look up by Specimen Type and/or Collection Sample"
28 D YN^DICN G:%<0 EXIT G:%=2 A
29 S DIR(0)="S^S:SPECIMEN TYPE;C:COLLECTION SAMPLE;B:BOTH;A:ALL or ANY (Will not prompt)"
30 S DIR("?")="<All> will not prompt for a specimen or sample"
31 D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT G @Y
32B D SPEC^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
33C D COLL^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G A
34S D SPEC^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
35A W !,"Do you want to select by TESTS or WKLD CODES (YES or NO )"
36 S %=2 D YN^DICN G:%=-1 EXIT
37 G:%=2 I D ASK G:$D(DUOUT)!($D(DTOUT)) EXIT K DIC,DIR
38 I Y="A" G L
39 I Y="W" D CAP^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G L
40 D TEST^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
41I D INSTR^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
42L ;
43 D STAT^LRCAPR1A G:$D(DUOUT)!($D(DTOUT))!(%<0) EXIT
44LOC ;
45 D G:$D(DUOUT)!($D(DTOUT)) EXIT
46 . N DIR S DIR(0)="YO",DIR("A")="Do you want to select Hospital Location ",DIR("B")="Yes"
47 . D ^DIR I Y'=1 S LRLOC="1A" Q
48 . D LOC^LRCAPR1A
49LEDIDIV ;Select LEDI Institution sites
50INST D G:$D(DUOUT)!($D(DTOUT)) EXIT
51 . N DIR,DIC
52 . I LRLOC="1A" S DIR("B")="Yes"
53 . S DIR(0)="YO",DIR("A")="Do you want to select LEDI Collecting Sites "
54 . D ^DIR I Y'=1 S LRLDIV="1A" Q
55 . S DIC=4,DIC(0)="AEMQ",DIC("A")="Select LEDI Collecting Sites : All // "
56 . F I=1:1 D ^DIC Q:Y=-1 S LRLDIV(+Y)=$P(^(0),U),DIC("A")="Select another Site: ",LRLDIV=I
57 I LRLDIV="1A",LRLOC="1A" D G LOC
58 . W !!?5,"<You HAVEN'T selected any locations> "
59 . S (LRLOC,LRLDIV)=0
60 D IOPAT^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
61 D CONTROL^LRCAPR1A G:LREND EXIT
62 D REPTYP^LRCAPR1A G:LREND EXIT
63 K DIR S DIR(0)="SX^D:DETAILED;C:CONDENSED",DIR("A")=" REPORT"
64 D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT S LRANS=Y K DIR
65 K IO("Q") S %ZIS="Q" D ^%ZIS G:POP EXIT I $D(IO("Q")) G QUE
66 D WAIT^DICD
67 U IO D ^LRCAPR2
68 Q
69ASK ;
70 S DIR(0)="S^T:TEST;W:WKLD CODE;A:ALL (means no specific TEST or WKLD CODE )",DIR("A")="Do you want to select by (T)est or (W)KLD Code or (A)ll"
71 S DIR("?")="All means no specified TEST or WKLD code is desired and will take you to the next prompt."
72 S DIR("?",1)="You can only select either by TESTs or by WKLD CODEs"
73 S DIR("?",2)="Choosing ALL will take you to the location prompt right away."
74 S DIR("?",3)="Selecting by WLKD codes will limit you to a particular test only,"
75 S DIR("?",4)="whereas by TEST might give you 1 or more WKLD codes."
76 D ^DIR
77 Q
78QUE ;
79 S ZTSAVE("LR*")="",ZTRTN="LRCAPR2",ZTDESC="WORKLOAD REPORT",ZTIO=ION
80 S:$G(LRSITE) ZTSAVE("LRSITE*")=""
81 S:$G(LRSP) ZTSAVE("LRSP*")="" S:$G(LRCOL) ZTSAVE("LRCOL*")=""
82 S:$G(LRTST) ZTSAVE("LRTST*")="" S:$G(LRCAPS) ZTSAVE("LRCAPS*")=""
83 S:$G(LRCPSX) ZTSAVE("LRCPSX*")="" S:$G(LRLOC) ZTSAVE("LRLOC*")=""
84 S:$G(LRLDIV) ZTSAVE("LRLDIV")=""
85 D ^%ZTLOAD,^%ZISC
86 S LREND=1
87EXIT ;
88 S LREND=1
89 D CLEAN^LRCAPR4 K LRLDIV,LREDT,LRSDT
90 Q
Note: See TracBrowser for help on using the repository browser.