LRUPQ.m

LRUPQ ; IHS/DIR/FJE - LAB RESULTS BY ACCESSION AREA 2/18/93 13:12 ;

 ;;5.2;LR;;NOV 01, 1997

 ;

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

 S DIC=68,DIC(0)="AEMOQ",DIC("S")="I $P(^(0),U,2)=""CH""" D ^DIC K DIC Q:Y<1  S LR=+Y,LR(1)=$P(Y,U,2),LR(3)="CH"

 K C W !!?20,LR(1)," ACCESSION LIST" S X="T",%DT="" D ^%DT S X=Y D D^LRU S Z(1)=Y,Y=X

 I $P(^LRO(68,LR,0),U,3)="Y" S X=$E(DT,2,3),%DT="" D ^%DT S X=Y D D^LRU S Z(1)=Y,Y=X

 W !!,"Accession list date:  ",Z(1),"  OK " S %=1 D YN^LRU Q:%<0

A I %=2 W ! S %DT("A")="Select DATE: ",%DT="AQE" D ^%DT K %DT Q:Y<1  S X=Y D D^LRU S Z(1)=Y,Y=X

 S LRAD=$S($P(^LRO(68,LR,0),U,3)="Y":$E(Y,1,3)_"0000",1:Y)

 I '$O(^LRO(68,LR,1,LRAD,1,0)) W $C(7),!!,"No accession numbers for ",Z(1) S %=2 G A

N1 I LRAD'["0000" R !,"Start with Acc #: FIRST // ",N(1):DTIME Q:'$T!(N(1)[U)  S:N(1)="" N(1)=1 I N(1)'?1N.N W $C(7),!!,"Enter NUMBERS only" G N1

 I LRAD["0000" R !,"Start with Acc #: ",N(1):DTIME Q:N(1)=""!(N(1)[U)  I N(1)'?1N.N W $C(7),!!,"NUMBERS ONLY !!" G N1

N2 R !,"Go    to   Acc #: LAST // ",N(2):DTIME Q:N(2)='$T!(N(2)[U)  S:N(2)="" N(2)=999999 I N(2)'?1N.N W $C(7),!!,"NUMBERS ONLY !!",!! G N2

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

QUE U IO D L,L^LRU,S^LRU S (Q(1),Q(2))=0,LRU=+$O(^LAB(61,"B","UNKNOWN",0)),LRU(1)=+$O(^LAB(62,"B","UNKNOWN",0)) D H S LR("F")=1

 S N=N(1)-1 F B=0:0 S N=$O(^LRO(68,LR,1,LRAD,1,N)) Q:'N!(N>N(2))!(LR("Q"))  S LRC(5)=$S($D(^LRO(68,LR,1,LRAD,1,N,3)):$P(^(3),"^",6),1:"") W !,LR(4) D ^LRUPQ1

 W:IOST'?1"C".E @IOF D END^LRUTL,END Q

 ;

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

 D F^LRU W !,"LABORATORY SERVICE ",?22,LR(1)," ACCESSIONS for ",Z(1)

 ;W !,"Acc #",?7,"Patient",?28,"SSN",?35,"LOC",?41,"Specimen",?56,"Received",?68,"Verified",!,LR("%") Q

 W !,"Acc #",?7,"Patient",?28,"HRCN",?35,"LOC",?41,"Specimen",?56,"Received",?68,"Verified",!,LR("%") Q  ;IHS/ANMC/CLS 08/18/96

 ;

L S LR(4)="" F X=2:1:IOM S LR(4)=LR(4)_"-"

 Q

 ;

END D V^LRU Q

LRUPQ     ; IHS/DIR/FJE - LAB RESULTS BY ACCESSION AREA 2/18/93 13:12 ;

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

 +2       ;

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

 +4        SET DIC=68

           SET DIC(0)="AEMOQ"

           SET DIC("S")="I $P(^(0),U,2)=""CH"""

           DO ^DIC

           KILL DIC

           IF Y<1

               QUIT 

           SET LR=+Y

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

           SET LR(3)="CH"

 +5        KILL C

           WRITE !!?20,LR(1)," ACCESSION LIST"

           SET X="T"

           SET %DT=""

           DO ^%DT

           SET X=Y

           DO D^LRU

           SET Z(1)=Y

           SET Y=X

 +6        IF $PIECE(^LRO(68,LR,0),U,3)="Y"

               SET X=$EXTRACT(DT,2,3)

               SET %DT=""

               DO ^%DT

               SET X=Y

               DO D^LRU

               SET Z(1)=Y

               SET Y=X

 +7        WRITE !!,"Accession list date:  ",Z(1),"  OK "

           SET %=1

           DO YN^LRU

           IF %<0

               QUIT 

A          IF %=2

               WRITE !

               SET %DT("A")="Select DATE: "

               SET %DT="AQE"

               DO ^%DT

               KILL %DT

               IF Y<1

                   QUIT 

               SET X=Y

               DO D^LRU

               SET Z(1)=Y

               SET Y=X

 +1        SET LRAD=$SELECT($PIECE(^LRO(68,LR,0),U,3)="Y":$EXTRACT(Y,1,3)_"0000",1:Y)

 +2        IF '$ORDER(^LRO(68,LR,1,LRAD,1,0))

               WRITE $CHAR(7),!!,"No accession numbers for ",Z(1)

               SET %=2

               GOTO A

N1         IF LRAD'["0000"

               READ !,"Start with Acc #: FIRST // ",N(1):DTIME

               IF '$TEST!(N(1)[U)

                   QUIT 

               IF N(1)=""

                   SET N(1)=1

               IF N(1)'?1N.N

                   WRITE $CHAR(7),!!,"Enter NUMBERS only"

                   GOTO N1

 +1        IF LRAD["0000"

               READ !,"Start with Acc #: ",N(1):DTIME

               IF N(1)=""!(N(1)[U)

                   QUIT 

               IF N(1)'?1N.N

                   WRITE $CHAR(7),!!,"NUMBERS ONLY !!"

                   GOTO N1

N2         READ !,"Go    to   Acc #: LAST // ",N(2):DTIME

           IF N(2)='$TEST!(N(2)[U)

               QUIT 

           IF N(2)=""

               SET N(2)=999999

           IF N(2)'?1N.N

               WRITE $CHAR(7),!!,"NUMBERS ONLY !!",!!

               GOTO N2

 +1        SET ZTRTN="QUE^LRUPQ"

           DO BEG^LRUTL

           IF POP!($DATA(ZTSK))

               GOTO END

QUE        USE IO

           DO L

           DO L^LRU

           DO S^LRU

           SET (Q(1),Q(2))=0

           SET LRU=+$ORDER(^LAB(61,"B","UNKNOWN",0))

           SET LRU(1)=+$ORDER(^LAB(62,"B","UNKNOWN",0))

           DO H

           SET LR("F")=1

 +1        SET N=N(1)-1

           FOR B=0:0

               SET N=$ORDER(^LRO(68,LR,1,LRAD,1,N))

               IF 'N!(N>N(2))!(LR("Q"))

                   QUIT 

               SET LRC(5)=$SELECT($DATA(^LRO(68,LR,1,LRAD,1,N,3)):$PIECE(^(3),"^",6),1:"")

               WRITE !,LR(4)

               DO ^LRUPQ1

 +2        IF IOST'?1"C".E

               WRITE @IOF

           DO END^LRUTL

           DO END

           QUIT 

 +3       ;

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

               IF IOST?1"C".E

                   DO M^LRU

                   IF LR("Q")

                       QUIT 

 +1        DO F^LRU

           WRITE !,"LABORATORY SERVICE ",?22,LR(1)," ACCESSIONS for ",Z(1)

 +2       ;W !,"Acc #",?7,"Patient",?28,"SSN",?35,"LOC",?41,"Specimen",?56,"Received",?68,"Verified",!,LR("%") Q

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

           WRITE !,"Acc #",?7,"Patient",?28,"HRCN",?35,"LOC",?41,"Specimen",?56,"Received",?68,"Verified",!,LR("%")

           QUIT 

 +4       ;

L          SET LR(4)=""

           FOR X=2:1:IOM

               SET LR(4)=LR(4)_"-"

 +1        QUIT 

 +2       ;

END        DO V^LRU

           QUIT