source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSORA0.m@ 1375

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1LRSORA0 ;DRH/DALISC - Continuation of LRSORA 07-28-93
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3INIT ;
4 S U="^"
5 Q
6STOP ;
7 D:($E(IOST,1,2)="C-")&('LREND) WAIT^LRSORA
8 W @IOF D:'$D(ZTQUEUED) ^%ZISC
9 K ^TMP("LR",$J)
10 K LRA,LRV,LRV2,LREND,LREDT,LRSDT,LRLONG,LRTST,LRTW,LRVX,T,W,X,Y,I,J,C
11 K DIC,DIR,DFN,VA("BID"),VA("PID"),VAERR,LRAN,LRDASH,LREDAT,LRHDR2,LRQUE
12 K LRLCS,LRMRK,LROLD,LRPAG,LRPTS,LRSDAT,LRSRT,LRSUB1,LRSUB2,LRTEST,LRVAL
13 K LREDT,LRSDT,LRTST,LRSPEC,LRSUB,LRDFN,LRLDFN,LRLIDT,LRLLOC,LRLONG,LRVDT
14 K LRWRD,LRLOG,LRCDT,LRIDT,LRIDT1,LRHI,LRLO,LRTHER,LRTOP,LRLOC,LRDPF
15 K SSN,PNM,AGE,DOB,SEX,V,%,%DT,LRPREC,DTOUT,DUOUT,ZTDESC,ZTQUEUED,ZTRTN
16 K ZTSK,ZTSAVE,%ZIS,POP,%X,%Y,LRSUB3,LRAA,LRAAA,LRDAT,LRTSTX,LRUNITS
17 K LRCHNG,LRCOMX,LRSORTI,LRCNT,REFCK,LRANF,LRANL,LRSPCK
18 K LRTIC,LRSPCK,NEWPG,LRTSTCK,LRCOUNT,LRPATCK,LRCHKSP,LRCDT,LRCHNG
19 Q
20GAA ;
21 S LRAA=0 W !
22 K DIR,X,Y S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
23 S DIR("A")="Do you want to select accession areas (YES or NO) "
24 S DIR("?")="Enter 'YES' to limit report to one or more accession areas."
25 D ^DIR
26 Q:Y="N"
27 I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
28 K DIC S DIC=68,DIC(0)="AEMQZ"
29 F D ^DIC Q:Y=-1 D
30 .S LRAA=+Y,LRAA($P(Y(0),U,11))=+Y
31 I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
32 Q
Note: See TracBrowser for help on using the repository browser.