LRUPACA.m

LRUPACA ;IHS/DIR/FJE - LAB ACC COUNTS BY LOC 2/18/93 13:09 ;JUL 06, 2010 3:14 PM

 ;;5.2;LAB SERVICE;**1007,1013,1015,1022,1027,1030**;NOV 01, 1997

 ;;5.2;LR;;NOV 01, 1997

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 ;;

EP ; Begin -- IHS/OIT/MKK - Patch 1022

 NEW LRAS

 ; END -- IHS/OIT/MKK - Patch 1022

 ;

 D END S DIC=68,DIC(0)="AEQMZ",DIC("S")="I ""AUCYEMSP""'[$P(^(0),U,2)&($P(^(0),U,2)]"""")" D ^DIC K DIC G:Y=-1 END S LRAA=+Y,LRAA(1)=$P(Y,U,2),LRSS=$P(Y(0),U,2)

 K T S (Z(4),T(2))=0

 W !!?20,LRAA(1)," ACCESSION COUNTS" D B^LRU G:Y<0 END

 S LRLDT=LRLDT+.99,T(3)=$S($P(^LRO(68,LRAA,0),U,3)="Y":$E(LRSDT,1,3)_"0000",1:LRSDT),T(4)=$S($P(^LRO(68,LRAA,0),U,3)="Y":$E(LRLDT,1,3)_"0000",1:LRLDT)

DEV S ZTRTN="QUE^LRUPACA" D BEG^LRUTL G:POP!($D(ZTSK)) END

QUE U IO K ^TMP($J) D:IOST?1"C".E WAIT^LRU D L^LRU,S^LRU,@($S(T(3)["0000":"ACY",1:"ACD"))

 S Y=$S($D(^TMP($J,"S")):^("S"),1:"") D D^LRU S LRB=Y,Y=$S($D(^TMP($J,"E")):^("E"),1:"") D D^LRU S LRE=Y

 D H1 S LR("F")=1,Q(2)=0,S=-1 F A=0:1 S S=$O(^TMP($J,"B",S)) Q:S=""!(LR("Q"))  D:$Y>(IOSL-6) H1 Q:LR("Q")  W !,S,?30,$J(^TMP($J,"B",S),5) S Q(2)=Q(2)+^(S) D T

 ;G:LR("Q") OUT W !?30,"-----",!,"Total Accessions: ",?30,$J(Q(2),5),?41,"Total tests: ",?70,$J(T(2),9) D H3 Q:LR("Q")

 ; G:LR("Q") OUT W !?30,"-----",?70,"_________",!,"Total Accessions: ",?30,$J(Q(2),5),?41,"Total tests: ",?70,$J(T(2),9) D H3 Q:LR("Q")  ;IHS/ANMC/CLS 08/18/96

 G:LR("Q") OUT W !?30,"-----",?70,"---------",!,"Total Accessions: ",?30,$J(Q(2),5),?41,"Total tests: ",?70,$J(T(2),9) D H3 Q:LR("Q")  ;IHS/OIT/MKK 05/20/2009 -- Patch 1027

 NEW TESTCNT,CUMCNT  ; IHS/OIT/MKK 05/20/2009 -- Patch 1027

 F T=0:0 S T=$O(^TMP($J,T)) Q:'T!(LR("Q"))  D:$Y>(IOSL-6) H3 Q:LR("Q")  W !,$S($D(^LAB(60,T,0)):$P(^(0),"^"),1:T) D B Q:LR("Q")

 ; ------ BEGIN IHS/OIT/MKK PATCH 1027 MODIFICATIONS

 ; W !

 ; W ?56,"---------"

 ; W !

 ; W ?36,"Total tests:"

 ; W ?56,$J(TESTCNT,9)

 ; W !

 ; ------ END IHS/OIT/MKK PATCH 1027 MODIFICATIONS

 ; ------ BEGIN IHS/OIT/MKK LR*5.2*1030 -- make sure TESTCNT variable > zero.

 I +$G(TESTCNT)>0 D

 . W !,?56,"---------",!

 . W ?36,"Total tests:",?56,$J(TESTCNT,9),!

 ; ------ END IHS/OIT/MKK LR*5.2*1030

OUT D END^LRUTL,END Q

T F T=0:0 S T=$O(^TMP($J,"B",S,T)) Q:'T!(LR("Q"))  D:$Y>(IOSL-6) H1 Q:LR("Q")  S T(1)=^TMP($J,"B",S,T) W !?41,$S($D(^LAB(60,T,0)):$P(^(0),"^"),1:T),?70,$J(T(1),9) S T(2)=T(2)+T(1)

 Q

B ; S V=0,S=0 F A=0:1 S S=$O(^TMP($J,T,S)) Q:S=""!(LR("Q"))  D:$Y>(IOSL-6) H3 Q:LR("Q")  S Z=^TMP($J,T,S) W !?30,S,?55,$J(Z,9) S V=V+Z W ?70,$J(V,9)

 ; Q

 ; ------ BEGIN IHS/OIT/MKK PATCH 1027 MODIFICATIONS

 NEW HEDIT

 S V=0,S=0

 F  S S=$O(^TMP($J,T,S))  Q:S=""!(LR("Q"))  D

 . S HEDIT=1

 . D:$Y>(IOSL-6) H3,TESTHEAD  Q:LR("Q")

 . S Z=$G(^TMP($J,T,S))

 . W:HEDIT !

 . W ?35,S

 . W ?56,$J(Z,9)

 . S V=V+Z

 . W ?70,$J(V,9)

 . S TESTCNT=Z+$G(TESTCNT)

 . S CUMCNT=V+$G(CUMCNT)

 Q

 ;

TESTHEAD ; EP

 W !,$S($D(^LAB(60,T,0)):$P(^(0),"^"),1:T)

 S HEDIT=0

 Q

 ; ------ END IHS/OIT/MKK PATCH 1027 MODIFICATIONS

 ;

ACY S T(3)=T(3)-1,LRB=$O(^LRO(68,LRAA,1,T(3))) F I=T(3):0 S I=$O(^LRO(68,LRAA,1,I)) Q:'I!(I>T(4))  S LRSA=LRSDT-.01,^TMP($J,"S")=$O(^LRO(68,LRAA,1,I,1,"E",LRSA)) D ACY1

 Q

ACY1 S LRE="" F B=LRSA:0 S B=$O(^LRO(68,LRAA,1,I,1,"E",B)) Q:'B!(B>LRLDT)  S LRE=B F LRAN=0:0 S LRAN=$O(^LRO(68,LRAA,1,I,1,"E",B,LRAN)) Q:'LRAN  D AC1

 S ^TMP($J,"E")=LRE Q

AC1 ;Q:'$D(^LRO(68,LRAA,1,I,1,LRAN,0))  Q:I'=$P(^(0),U,3)  S X=^(0),LRLLOC=$S($L($P(X,U,7)):$P(X,U,7),$P(X,U,2)=62.3:"QC--"_$P(^LAB(62.3,$P(^LR($P(X,"^"),0),U,3),0),"^"),1:"???")

 Q:'$D(^LRO(68,LRAA,1,I,1,LRAN,0))  Q:I'=$P(^(0),U,3)  S X=^(0),LRLLOC=$S($L($P(X,U,7)):$P(X,U,7),$P(X,U,2)=62.3:"QC--"_$P($G(^LAB(62.3,$P(^LR($P(X,"^"),0),U,3),0),"DELETED CONTROL"),"^"),1:"???")  ;IHS/ITSC/TPF 10/1/01 PATCH **1013*

 S:'$D(^TMP($J,"B",LRLLOC)) ^(LRLLOC)=0 S ^(LRLLOC)=^(LRLLOC)+1

 ; F T=0:0 S T=$O(^LRO(68,LRAA,1,I,1,LRAN,4,T)) Q:'T  S:'$D(^TMP($J,"B",LRLLOC,T)) ^(T)=0 S ^(T)=^(T)+1 S:'$D(^TMP($J,T,LRLLOC)) ^(LRLLOC)=0 S ^(LRLLOC)=^(LRLLOC)+1

 ; Begin -- IHS/OIT/MKK - Patch 1022

 F T=0:0 S T=$O(^LRO(68,LRAA,1,I,1,LRAN,4,T)) Q:'T  D

 . I $P($G(^LRO(68,LRAA,1,I,1,LRAN,4,T,0)),"^",5)="" Q   ; Must have Completed Date

 . ;

 . ; Make sure Accession is different

 . ; I $D(LRAS(LRAA,1,I,1,LRAN,T))>0 Q        ; If accession's test has already been done, skip

 . I $D(^TMP("LRUPACA",$J,LRAA,1,I,1,LRAN,T))>0 Q     ; IHS/OIT/MKK Lab Patch 1027

 . ;

 . ; S LRAS(LRAA,1,I,1,LRAN,T)=""             ; Set accession array

 . S ^TMP("LRUPACA",$J,LRAA,1,I,1,LRAN,T)=""     ; IHS/OIT/MKK Lab Patch 1027

 . ;

 . ; Get rid of naked references

 . ; S:'$D(^TMP($J,"B",LRLLOC,T)) ^(T)=0

 . ; S ^(T)=^(T)+1

 . ; S:'$D(^TMP($J,T,LRLLOC)) ^(LRLLOC)=0 

 . ; S ^(LRLLOC)=^(LRLLOC)+1

 . ;

 . S ^TMP($J,"B",LRLLOC,T)=1+$G(^TMP($J,"B",LRLLOC,T))

 . S ^TMP($J,T,LRLLOC)=1+$G(^TMP($J,T,LRLLOC))

 ; End -- IHS/OIT/MKK - Patch 1022

 Q

ACD S LRE="",T(3)=T(3)-1,^TMP($J,"S")=$O(^LRO(68,LRAA,1,T(3))) F I=T(3):0 S I=$O(^LRO(68,LRAA,1,I)) Q:'I!(I>T(4))  S LRE=I F LRAN=0:0 S LRAN=$O(^LRO(68,LRAA,1,I,1,LRAN)) Q:'LRAN  D AC1

 S ^TMP($J,"E")=LRE Q

H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")

 S LRQ=LRQ+1,X="N",%DT="T" D ^%DT,D^LRU W @IOF,!,Y,?22,LRQ(1),?(IOM-10),"Pg: ",LRQ  ;IHS/DIRT/FJE 4/5/99

 W !,"LABORATORY SERVICE ",LRAA(1)," COUNTS (",LRSTR,"-",LRLST,")",!,"INCLUSIVE DATES WITH DATA: ",LRB W:LRE]"" " TO ",LRE Q  ;IHS/DIRT/FJE 4/5/99 REMOVED D F^LRU

H1 D H Q:LR("Q")  W !,"Location",?26,"# Accessions",?69,"Test count",!,LR("%") Q

H2 D H Q:LR("Q")  W !,S Q

H3 D H Q:LR("Q")  W !,"Test",?35,"Location",?55,"Test count",?70,"Cum count",!,LR("%") Q

 ;

END ; D V^LRU Q

 D V^LRU  K ^TMP("LRUPACA",$J)  Q  ; IHS/OIT/MKK - Lab Patch 1027

LRUPACA   ;IHS/DIR/FJE - LAB ACC COUNTS BY LOC 2/18/93 13:09 ;JUL 06, 2010 3:14 PM

 +1       ;;5.2;LAB SERVICE;**1007,1013,1015,1022,1027,1030**;NOV 01, 1997

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

 +3       ;

 +4       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +5       ;;

EP        ; Begin -- IHS/OIT/MKK - Patch 1022

 +1        NEW LRAS

 +2       ; END -- IHS/OIT/MKK - Patch 1022

 +3       ;

 +4        DO END

           SET DIC=68

           SET DIC(0)="AEQMZ"

           SET DIC("S")="I ""AUCYEMSP""'[$P(^(0),U,2)&($P(^(0),U,2)]"""")"

           DO ^DIC

           KILL DIC

           IF Y=-1

               GOTO END

           SET LRAA=+Y

           SET LRAA(1)=$PIECE(Y,U,2)

           SET LRSS=$PIECE(Y(0),U,2)

 +5        KILL T

           SET (Z(4),T(2))=0

 +6        WRITE !!?20,LRAA(1)," ACCESSION COUNTS"

           DO B^LRU

           IF Y<0

               GOTO END

 +7        SET LRLDT=LRLDT+.99

           SET T(3)=$SELECT($PIECE(^LRO(68,LRAA,0),U,3)="Y":$EXTRACT(LRSDT,1,3)_"0000",1:LRSDT)

           SET T(4)=$SELECT($PIECE(^LRO(68,LRAA,0),U,3)="Y":$EXTRACT(LRLDT,1,3)_"0000",1:LRLDT)

DEV        SET ZTRTN="QUE^LRUPACA"

           DO BEG^LRUTL

           IF POP!($DATA(ZTSK))

               GOTO END

QUE        USE IO

           KILL ^TMP($JOB)

           IF IOST?1"C".E

               DO WAIT^LRU

           DO L^LRU

           DO S^LRU

           DO @($SELECT(T(3)["0000":"ACY",1:"ACD"))

 +1        SET Y=$SELECT($DATA(^TMP($JOB,"S")):^("S"),1:"")

           DO D^LRU

           SET LRB=Y

           SET Y=$SELECT($DATA(^TMP($JOB,"E")):^("E"),1:"")

           DO D^LRU

           SET LRE=Y

 +2        DO H1

           SET LR("F")=1

           SET Q(2)=0

           SET S=-1

           FOR A=0:1

               SET S=$ORDER(^TMP($JOB,"B",S))

               IF S=""!(LR("Q"))

                   QUIT 

               IF $Y>(IOSL-6)

                   DO H1

               IF LR("Q")

                   QUIT 

               WRITE !,S,?30,$JUSTIFY(^TMP($JOB,"B",S),5)

               SET Q(2)=Q(2)+^(S)

               DO T

 +3       ;G:LR("Q") OUT W !?30,"-----",!,"Total Accessions: ",?30,$J(Q(2),5),?41,"Total tests: ",?70,$J(T(2),9) D H3 Q:LR("Q")

 +4       ; G:LR("Q") OUT W !?30,"-----",?70,"_________",!,"Total Accessions: ",?30,$J(Q(2),5),?41,"Total tests: ",?70,$J(T(2),9) D H3 Q:LR("Q")  ;IHS/ANMC/CLS 08/18/96

 +5       ;IHS/OIT/MKK 05/20/2009 -- Patch 1027

           IF LR("Q")

               GOTO OUT

           WRITE !?30,"-----",?70,"---------",!,"Total Accessions: ",?30,$JUSTIFY(Q(2),5),?41,"Total tests: ",?70,$JUSTIFY(T(2),9)

           DO H3

           IF LR("Q")

               QUIT 

 +6       ; IHS/OIT/MKK 05/20/2009 -- Patch 1027

           NEW TESTCNT,CUMCNT

 +7        FOR T=0:0

               SET T=$ORDER(^TMP($JOB,T))

               IF 'T!(LR("Q"))

                   QUIT 

               IF $Y>(IOSL-6)

                   DO H3

               IF LR("Q")

                   QUIT 

               WRITE !,$SELECT($DATA(^LAB(60,T,0)):$PIECE(^(0),"^"),1:T)

               DO B

               IF LR("Q")

                   QUIT 

 +8       ; ------ BEGIN IHS/OIT/MKK PATCH 1027 MODIFICATIONS

 +9       ; W !

 +10      ; W ?56,"---------"

 +11      ; W !

 +12      ; W ?36,"Total tests:"

 +13      ; W ?56,$J(TESTCNT,9)

 +14      ; W !

 +15      ; ------ END IHS/OIT/MKK PATCH 1027 MODIFICATIONS

 +16      ; ------ BEGIN IHS/OIT/MKK LR*5.2*1030 -- make sure TESTCNT variable > zero.

 +17       IF +$GET(TESTCNT)>0

               Begin DoDot:1

 +18               WRITE !,?56,"---------",!

 +19               WRITE ?36,"Total tests:",?56,$JUSTIFY(TESTCNT,9),!

               End DoDot:1

 +20      ; ------ END IHS/OIT/MKK LR*5.2*1030

OUT        DO END^LRUTL

           DO END

           QUIT 

T          FOR T=0:0

               SET T=$ORDER(^TMP($JOB,"B",S,T))

               IF 'T!(LR("Q"))

                   QUIT 

               IF $Y>(IOSL-6)

                   DO H1

               IF LR("Q")

                   QUIT 

               SET T(1)=^TMP($JOB,"B",S,T)

               WRITE !?41,$SELECT($DATA(^LAB(60,T,0)):$PIECE(^(0),"^"),1:T),?70,$JUSTIFY(T(1),9)

               SET T(2)=T(2)+T(1)

 +1        QUIT 

B         ; S V=0,S=0 F A=0:1 S S=$O(^TMP($J,T,S)) Q:S=""!(LR("Q"))  D:$Y>(IOSL-6) H3 Q:LR("Q")  S Z=^TMP($J,T,S) W !?30,S,?55,$J(Z,9) S V=V+Z W ?70,$J(V,9)

 +1       ; Q

 +2       ; ------ BEGIN IHS/OIT/MKK PATCH 1027 MODIFICATIONS

 +3        NEW HEDIT

 +4        SET V=0

           SET S=0

 +5        FOR 

               SET S=$ORDER(^TMP($JOB,T,S))

               IF S=""!(LR("Q"))

                   QUIT 

               Begin DoDot:1

 +6                SET HEDIT=1

 +7                IF $Y>(IOSL-6)

                       DO H3

                       DO TESTHEAD

                   IF LR("Q")

                       QUIT 

 +8                SET Z=$GET(^TMP($JOB,T,S))

 +9                IF HEDIT

                       WRITE !

 +10               WRITE ?35,S

 +11               WRITE ?56,$JUSTIFY(Z,9)

 +12               SET V=V+Z

 +13               WRITE ?70,$JUSTIFY(V,9)

 +14               SET TESTCNT=Z+$GET(TESTCNT)

 +15               SET CUMCNT=V+$GET(CUMCNT)

               End DoDot:1

 +16       QUIT 

 +17      ;

TESTHEAD  ; EP

 +1        WRITE !,$SELECT($DATA(^LAB(60,T,0)):$PIECE(^(0),"^"),1:T)

 +2        SET HEDIT=0

 +3        QUIT 

 +4       ; ------ END IHS/OIT/MKK PATCH 1027 MODIFICATIONS

 +5       ;

ACY        SET T(3)=T(3)-1

           SET LRB=$ORDER(^LRO(68,LRAA,1,T(3)))

           FOR I=T(3):0

               SET I=$ORDER(^LRO(68,LRAA,1,I))

               IF 'I!(I>T(4))

                   QUIT 

               SET LRSA=LRSDT-.01

               SET ^TMP($JOB,"S")=$ORDER(^LRO(68,LRAA,1,I,1,"E",LRSA))

               DO ACY1

 +1        QUIT 

ACY1       SET LRE=""

           FOR B=LRSA:0

               SET B=$ORDER(^LRO(68,LRAA,1,I,1,"E",B))

               IF 'B!(B>LRLDT)

                   QUIT 

               SET LRE=B

               FOR LRAN=0:0

                   SET LRAN=$ORDER(^LRO(68,LRAA,1,I,1,"E",B,LRAN))

                   IF 'LRAN

                       QUIT 

                   DO AC1

 +1        SET ^TMP($JOB,"E")=LRE

           QUIT 

AC1       ;Q:'$D(^LRO(68,LRAA,1,I,1,LRAN,0))  Q:I'=$P(^(0),U,3)  S X=^(0),LRLLOC=$S($L($P(X,U,7)):$P(X,U,7),$P(X,U,2)=62.3:"QC--"_$P(^LAB(62.3,$P(^LR($P(X,"^"),0),U,3),0),"^"),1:"???")

 +1       ;IHS/ITSC/TPF 10/1/01 PATCH **1013*

           IF '$DATA(^LRO(68,LRAA,1,I,1,LRAN,0))

               QUIT 

           IF I'=$PIECE(^(0),U,3)

               QUIT 

           SET X=^(0)

           SET LRLLOC=$SELECT($LENGTH($PIECE(X,U,7)):$PIECE(X,U,7),$PIECE(X,U,2)=62.3:"QC--"_$PIECE($GET(^LAB(62.3,$PIECE(^LR($PIECE(X,"^"),0),U,3),0),"DELETED CONTROL"),"^"),1:"???")

 +2        IF '$DATA(^TMP($JOB,"B",LRLLOC))

               SET ^(LRLLOC)=0

           SET ^(LRLLOC)=^(LRLLOC)+1

 +3       ; F T=0:0 S T=$O(^LRO(68,LRAA,1,I,1,LRAN,4,T)) Q:'T  S:'$D(^TMP($J,"B",LRLLOC,T)) ^(T)=0 S ^(T)=^(T)+1 S:'$D(^TMP($J,T,LRLLOC)) ^(LRLLOC)=0 S ^(LRLLOC)=^(LRLLOC)+1

 +4       ; Begin -- IHS/OIT/MKK - Patch 1022

 +5        FOR T=0:0

               SET T=$ORDER(^LRO(68,LRAA,1,I,1,LRAN,4,T))

               IF 'T

                   QUIT 

               Begin DoDot:1

 +6       ; Must have Completed Date

                   IF $PIECE($GET(^LRO(68,LRAA,1,I,1,LRAN,4,T,0)),"^",5)=""

                       QUIT 

 +7       ;

 +8       ; Make sure Accession is different

 +9       ; I $D(LRAS(LRAA,1,I,1,LRAN,T))>0 Q        ; If accession's test has already been done, skip

 +10      ; IHS/OIT/MKK Lab Patch 1027

                   IF $DATA(^TMP("LRUPACA",$JOB,LRAA,1,I,1,LRAN,T))>0

                       QUIT 

 +11      ;

 +12      ; S LRAS(LRAA,1,I,1,LRAN,T)=""             ; Set accession array

 +13      ; IHS/OIT/MKK Lab Patch 1027

                   SET ^TMP("LRUPACA",$JOB,LRAA,1,I,1,LRAN,T)=""

 +14      ;

 +15      ; Get rid of naked references

 +16      ; S:'$D(^TMP($J,"B",LRLLOC,T)) ^(T)=0

 +17      ; S ^(T)=^(T)+1

 +18      ; S:'$D(^TMP($J,T,LRLLOC)) ^(LRLLOC)=0 

 +19      ; S ^(LRLLOC)=^(LRLLOC)+1

 +20      ;

 +21               SET ^TMP($JOB,"B",LRLLOC,T)=1+$GET(^TMP($JOB,"B",LRLLOC,T))

 +22               SET ^TMP($JOB,T,LRLLOC)=1+$GET(^TMP($JOB,T,LRLLOC))

               End DoDot:1

 +23      ; End -- IHS/OIT/MKK - Patch 1022

 +24       QUIT 

ACD        SET LRE=""

           SET T(3)=T(3)-1

           SET ^TMP($JOB,"S")=$ORDER(^LRO(68,LRAA,1,T(3)))

           FOR I=T(3):0

               SET I=$ORDER(^LRO(68,LRAA,1,I))

               IF 'I!(I>T(4))

                   QUIT 

               SET LRE=I

               FOR LRAN=0:0

                   SET LRAN=$ORDER(^LRO(68,LRAA,1,I,1,LRAN))

                   IF 'LRAN

                       QUIT 

                   DO AC1

 +1        SET ^TMP($JOB,"E")=LRE

           QUIT 

H          IF $DATA(LR("F"))

               IF IOST?1"C".E

                   DO M^LRU

                   IF LR("Q")

                       QUIT 

 +1       ;IHS/DIRT/FJE 4/5/99

           SET LRQ=LRQ+1

           SET X="N"

           SET %DT="T"

           DO ^%DT

           DO D^LRU

           WRITE @IOF,!,Y,?22,LRQ(1),?(IOM-10),"Pg: ",LRQ

 +2       ;IHS/DIRT/FJE 4/5/99 REMOVED D F^LRU

           WRITE !,"LABORATORY SERVICE ",LRAA(1)," COUNTS (",LRSTR,"-",LRLST,")",!,"INCLUSIVE DATES WITH DATA: ",LRB

           IF LRE]""

               WRITE " TO ",LRE

           QUIT 

H1         DO H

           IF LR("Q")

               QUIT 

           WRITE !,"Location",?26,"# Accessions",?69,"Test count",!,LR("%")

           QUIT 

H2         DO H

           IF LR("Q")

               QUIT 

           WRITE !,S

           QUIT 

H3         DO H

           IF LR("Q")

               QUIT 

           WRITE !,"Test",?35,"Location",?55,"Test count",?70,"Cum count",!,LR("%")

           QUIT 

 +1       ;

END       ; D V^LRU Q

 +1       ; IHS/OIT/MKK - Lab Patch 1027

           DO V^LRU

           KILL ^TMP("LRUPACA",$JOB)

           QUIT