LRSORA0 ;DRH/DALISC - Continuation of LRSORA 07-28-93
;;5.2;LAB SERVICE;;Sep 27, 1994
INIT ;
S U="^"
Q
STOP ;
D:($E(IOST,1,2)="C-")&('LREND) WAIT^LRSORA
W @IOF D:'$D(ZTQUEUED) ^%ZISC
K ^TMP("LR",$J)
K LRA,LRV,LRV2,LREND,LREDT,LRSDT,LRLONG,LRTST,LRTW,LRVX,T,W,X,Y,I,J,C
K DIC,DIR,DFN,VA("BID"),VA("PID"),VAERR,LRAN,LRDASH,LREDAT,LRHDR2,LRQUE
K LRLCS,LRMRK,LROLD,LRPAG,LRPTS,LRSDAT,LRSRT,LRSUB1,LRSUB2,LRTEST,LRVAL
K LREDT,LRSDT,LRTST,LRSPEC,LRSUB,LRDFN,LRLDFN,LRLIDT,LRLLOC,LRLONG,LRVDT
K LRWRD,LRLOG,LRCDT,LRIDT,LRIDT1,LRHI,LRLO,LRTHER,LRTOP,LRLOC,LRDPF
K SSN,PNM,AGE,DOB,SEX,V,%,%DT,LRPREC,DTOUT,DUOUT,ZTDESC,ZTQUEUED,ZTRTN
K ZTSK,ZTSAVE,%ZIS,POP,%X,%Y,LRSUB3,LRAA,LRAAA,LRDAT,LRTSTX,LRUNITS
K LRCHNG,LRCOMX,LRSORTI,LRCNT,REFCK,LRANF,LRANL,LRSPCK
K LRTIC,LRSPCK,NEWPG,LRTSTCK,LRCOUNT,LRPATCK,LRCHKSP,LRCDT,LRCHNG
Q
GAA ;
S LRAA=0 W !
K DIR,X,Y S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
S DIR("A")="Do you want to select accession areas (YES or NO) "
S DIR("?")="Enter 'YES' to limit report to one or more accession areas."
D ^DIR
Q:Y="N"
I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
K DIC S DIC=68,DIC(0)="AEMQZ"
F D ^DIC Q:Y=-1 D
.S LRAA=+Y,LRAA($P(Y(0),U,11))=+Y
I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSORA0 1259 printed Dec 13, 2024@02:20:26 Page 2
LRSORA0 ;DRH/DALISC - Continuation of LRSORA 07-28-93
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
INIT ;
+1 SET U="^"
+2 QUIT
STOP ;
+1 if ($EXTRACT(IOST,1,2)="C-")&('LREND)
DO WAIT^LRSORA
+2 WRITE @IOF
if '$DATA(ZTQUEUED)
DO ^%ZISC
+3 KILL ^TMP("LR",$JOB)
+4 KILL LRA,LRV,LRV2,LREND,LREDT,LRSDT,LRLONG,LRTST,LRTW,LRVX,T,W,X,Y,I,J,C
+5 KILL DIC,DIR,DFN,VA("BID"),VA("PID"),VAERR,LRAN,LRDASH,LREDAT,LRHDR2,LRQUE
+6 KILL LRLCS,LRMRK,LROLD,LRPAG,LRPTS,LRSDAT,LRSRT,LRSUB1,LRSUB2,LRTEST,LRVAL
+7 KILL LREDT,LRSDT,LRTST,LRSPEC,LRSUB,LRDFN,LRLDFN,LRLIDT,LRLLOC,LRLONG,LRVDT
+8 KILL LRWRD,LRLOG,LRCDT,LRIDT,LRIDT1,LRHI,LRLO,LRTHER,LRTOP,LRLOC,LRDPF
+9 KILL SSN,PNM,AGE,DOB,SEX,V,%,%DT,LRPREC,DTOUT,DUOUT,ZTDESC,ZTQUEUED,ZTRTN
+10 KILL ZTSK,ZTSAVE,%ZIS,POP,%X,%Y,LRSUB3,LRAA,LRAAA,LRDAT,LRTSTX,LRUNITS
+11 KILL LRCHNG,LRCOMX,LRSORTI,LRCNT,REFCK,LRANF,LRANL,LRSPCK
+12 KILL LRTIC,LRSPCK,NEWPG,LRTSTCK,LRCOUNT,LRPATCK,LRCHKSP,LRCDT,LRCHNG
+13 QUIT
GAA ;
+1 SET LRAA=0
WRITE !
+2 KILL DIR,X,Y
SET DIR(0)="S^Y:YES;N:NO"
SET DIR("B")="NO"
+3 SET DIR("A")="Do you want to select accession areas (YES or NO) "
+4 SET DIR("?")="Enter 'YES' to limit report to one or more accession areas."
+5 DO ^DIR
+6 if Y="N"
QUIT
+7 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
QUIT
+8 KILL DIC
SET DIC=68
SET DIC(0)="AEMQZ"
+9 FOR
DO ^DIC
if Y=-1
QUIT
Begin DoDot:1
+10 SET LRAA=+Y
SET LRAA($PIECE(Y(0),U,11))=+Y
End DoDot:1
+11 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
QUIT
+12 QUIT
