LRSORA0.m

LRSORA0 ; IHS/DIR/FJE - Continuation of LRSORA 07-28-93 ;

 ;;5.2;LR;;NOV 01, 1997

 ;

 ;;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 SSN,HRNC,PNM,AGE,DOB,SEX,V,%,%DT,LRPREC,DTOUT,DUOUT,ZTDESC,ZTQUEUED,ZTRTN  ;IHS/ANMC/CLS 08/18/96

 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

LRSORA0   ; IHS/DIR/FJE - Continuation of LRSORA 07-28-93 ;

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;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       ;K SSN,PNM,AGE,DOB,SEX,V,%,%DT,LRPREC,DTOUT,DUOUT,ZTDESC,ZTQUEUED,ZTRTN

 +10      ;IHS/ANMC/CLS 08/18/96

           KILL SSN,HRNC,PNM,AGE,DOB,SEX,V,%,%DT,LRPREC,DTOUT,DUOUT,ZTDESC,ZTQUEUED,ZTRTN

 +11       KILL ZTSK,ZTSAVE,%ZIS,POP,%X,%Y,LRSUB3,LRAA,LRAAA,LRDAT,LRTSTX,LRUNITS

 +12       KILL LRCHNG,LRCOMX,LRSORTI,LRCNT,REFCK,LRANF,LRANL,LRSPCK

 +13       KILL LRTIC,LRSPCK,NEWPG,LRTSTCK,LRCOUNT,LRPATCK,LRCHKSP,LRCDT,LRCHNG

 +14       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