source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRSORD.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1LRSORD ;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^LRSORD1A 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 Q
43DEVICE ;
44 I 'LREND D
45 .S %ZIS="Q" D ^%ZIS S:POP LREND=1
46 .I ($D(IO("Q")))&('LREND) D
47 ..S ZTRTN="DQ^LRSORD",ZTSAVE("LR*")=""
48 ..K IO("Q") D ^%ZTLOAD S LREND=1
49 Q
50DQ ;
51 K ^TMP("LR",$J)
52 S:$D(ZTQUEUED) ZTREQ="@" U IO
53 S (LRPAG,LREND)=0,$P(LRDASH,"-",IOM)="-"
54 K %DT S X="N",%DT="T" D ^%DT,DD^LRX S LRDATE=Y
55 K %DT S X=$P(LRSDT,"."),%DT="X" D ^%DT,DD^LRX S LRSDAT=Y
56 K %DT S X=LREDT,%DT="X" D ^%DT,DD^LRX S LREDAT=Y
57 S LRHDR2="For date range: "_LREDAT_" to "_LRSDAT
58 D BUILD^LRSORD1
59 D ^LRSORD1A
60 QUIT
Note: See TracBrowser for help on using the repository browser.