source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRSORC.m

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1LRSORC ;SLC/RWF/DALISC/JBM - CRITICAL VALUE REPORT ; 8/30/87 17:25 ;
2 ;;5.2;LAB SERVICE;**84**;Sep 27, 1994
3EN ;
4 D OPTIONS
5 D:'LREND DEVICE
6 I LREND D END^LRSORC1A Q
7 D DQ
8 Q
9OPTIONS ;
10 S LREDT="T-1",LREND=0 D ^LRWU3
11 D GAA,SORTBY:'LREND,SELPAT:'LREND,SELLOC:'LREND
12 Q
13GAA S LRAA=0 W !
14 K DIR,X,Y S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
15 S DIR("A")="Do you want to select accession areas (YES or NO) "
16 S DIR("?")="Enter 'YES' to limit report to one or more accession areas."
17 D ^DIR
18 Q:Y="N"
19 I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
20 K DIC S DIC=68,DIC(0)="AEMQZ"
21 F D ^DIC Q:Y=-1 D
22 .S LRAA=+Y,LRAA($P(Y(0),U,11))=+Y
23 I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
24 Q
25SORTBY K DIR S DIR("B")="P",DIR("A")="Sort by PATIENT or by LOCATION"
26 S DIR(0)="S^P:PATIENT;L:LOCATION",DIR("?")="Choose print sorting order."
27 D ^DIR S:($D(DUOUT))!($D(DTOUT)) LREND=1 Q:LREND S LRSRT=Y
28 Q
29SELPAT S LRPTS=0
30 K DIC S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select PATIENT NAME: All//"
31 F I=1:1 D ^DIC Q:Y=-1 S LRPTS(+Y)=$P(Y,U,2),DIC("A")="Select another PATIENT: ",LRPTS=I
32 S:($D(DUOUT))!($D(DTOUT)) LREND=1
33 Q
34SELLOC S LRLCS=0
35 K DIC S DIC="^SC(",DIC(0)="AEMQZ",DIC("A")="Select LOCATION: All//"
36 F I=1:1 D ^DIC Q:Y=-1 D
37 .S DIC("A")="Select another LOCATION: "
38 .I '$L($P(Y(0),"^",2)) W !!,$P(Y,"^",2)," does not have an Abbreviation in the Hospital Location file.",! Q
39 .S LRLCS($P(Y(0),U,2))=+Y,LRLCS=I
40 .Q
41 S:($D(DUOUT))!($D(DTOUT)) LREND=1
42 I $G(LRLCS) S LRLCS("NO ABRV")=""
43 Q
44DEVICE ;
45 I 'LREND D
46 .S %ZIS="Q" D ^%ZIS S:POP LREND=1
47 .I ($D(IO("Q")))&('LREND) D
48 ..S ZTRTN="DQ^LRSORC",ZTSAVE("LR*")=""
49 ..K IO("Q") D ^%ZTLOAD S LREND=1
50 Q
51DQ ;
52 K ^TMP("LR",$J)
53 S:$D(ZTQUEUED) ZTREQ="@" U IO
54 S (LRPAG,LREND)=0,$P(LRDASH,"-",IOM)="-"
55 K %DT S X="N",%DT="T" D ^%DT,DD^LRX S LRDATE=Y
56 K %DT S X=$P(LRSDT,"."),%DT="X" D ^%DT,DD^LRX S LRSDAT=Y
57 K %DT S X=LREDT,%DT="X" D ^%DT,DD^LRX S LREDAT=Y
58 S LRHDR2="For date range: "_LREDAT_" to "_LRSDAT
59 D BUILD^LRSORC1
60 D ^LRSORC1A
61 QUIT
Note: See TracBrowser for help on using the repository browser.