LRUPA ;AVAMC/REG/WTY - LAB ACCESSION LIST:DATE & TEST ;9/25/00
;;5.2;LAB SERVICE;**72,248**;Sep 27, 1994
;
;Reference to ^%DT supported by IA #10003
;Reference to ^DIC supported by IA #10006
;
I '$D(LRAA)!('$D(LRAA(1))) D ^LRUBYDIV G:'$D(Y) END
S:'$D(LRO(68)) LRO(68)=LRAA(1) K C W !!?20,LRO(68)," ACCESSION LIST" S X="T",%DT="" D ^%DT S X=Y D D^LRU S Z(1)=Y,Y=X
I $P(^LRO(68,LRAA,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 G:%<0 END
A I %=2 W ! S %DT("A")="Select DATE: ",%DT="AQE" D ^%DT K %DT G:Y<1 END S X=Y D D^LRU S Z(1)=Y,Y=X
S LRAD=$S($P(^LRO(68,LRAA,0),U,3)="Y":$E(Y,1,3)_"0000",1:Y)
I '$D(^LRO(68,LRAA,1,LRAD,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 G:'$T!(N(1)[U) END 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 G:N(1)=""!(N(1)[U) END I N(1)'?1N.N W $C(7),!!,"NUMBERS ONLY !!" G N1
N2 R !,"Go to Acc #: LAST // ",N(2):DTIME G:N(2)='$T!(N(2)[U) END S:N(2)="" N(2)=999999 I N(2)'?1N.N W $C(7),!!,"NUMBERS ONLY !!",!! G N2
W !!,"LIST BY PATIENT " S %=2 D YN^LRU G:%=1 ^LRUPA2 G:%<1 END
I "CHMI"[LRSS W !!,"LIST BY COLLECTION SAMPLE " S %=2 D YN^LRU G:%<0 END I %=1 S DIC=62,DIC(0)="AEMQ",DIC("A")="Select COLLECTION SAMPLE: " D ^DIC K DIC G:Y<1 END S C(1)=+Y,C=$P(Y,U,2)
S ZTRTN="QUE^LRUPA" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO S (Q(1),Q(2))=0,LRU(1)=+$O(^LAB(62,"B","UNKNOWN",0)) D L^LRU,S^LRU,H S LR("F")=1
S N=N(1)-1 F B=0:0 S N=$O(^LRO(68,LRAA,1,LRAD,1,N)) Q:'N!(N>N(2))!(LR("Q")) S LRC(5)=$S($D(^LRO(68,LRAA,1,LRAD,1,N,3)):$P(^(3),"^",6),1:"") D ^LRUPA1
Q:LR("Q") I LRSS="CY" D:$Y>(IOSL-8) H Q:LR("Q") W !?72,"-----",!,"Cell block (b) count: ",Q(1),?58,"Slide count:",?72,$J(Q(2),5)
I $G(LRSS)="BB" W:IOST'?1"C".E @IOF
I $G(LRSS)'="BB" D
.W:IOST'?1"C".E&($E(IOST,1,2)'="P-"!($D(LR("FORM")))) @IOF
D END^LRUTL,END
Q
H ;from LRUPA1
I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,LRO(68)," ACCESSIONS for ",Z(1),! W:$D(C)#2 "Collection Sample: ",C,!
W "# = Not VA patient " W:LRSS="CY" "* = Reviewed by pathologist" W:LRSS="CH" ?30,"*=STAT" W ?55,$S("SPCYEMAU"[LRSS:"% =Incomplete",1:"") I LRSS="CY" W ?72,"Slide"
W !,"Acc num",?12,$S(LRSS="MI":"Patient/Source",1:"Patient"),?28,"ID",?34,"Loc" I "CYEMSP"[LRSS W ?48,"Organ/tissue",!,LR("%") Q
W ?40 W:"AUBBCYEMSP"'[LRSS "Specimen/Sample" W:LRSS="BB" "Specimen date" I LRSS="CY" W ?72,"Count"
I "BBCHMI"[LRSS W ?64,"Test",?76,"Tech",!,LR("%") Q
W:LRSS="AU" ?42,"Date/time of Autopsy" W !,LR("%") Q
;
END D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUPA 2699 printed Dec 13, 2024@02:21:50 Page 2
LRUPA ;AVAMC/REG/WTY - LAB ACCESSION LIST:DATE & TEST ;9/25/00
+1 ;;5.2;LAB SERVICE;**72,248**;Sep 27, 1994
+2 ;
+3 ;Reference to ^%DT supported by IA #10003
+4 ;Reference to ^DIC supported by IA #10006
+5 ;
+6 IF '$DATA(LRAA)!('$DATA(LRAA(1)))
DO ^LRUBYDIV
if '$DATA(Y)
GOTO END
+7 if '$DATA(LRO(68))
SET LRO(68)=LRAA(1)
KILL C
WRITE !!?20,LRO(68)," ACCESSION LIST"
SET X="T"
SET %DT=""
DO ^%DT
SET X=Y
DO D^LRU
SET Z(1)=Y
SET Y=X
+8 IF $PIECE(^LRO(68,LRAA,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
+9 WRITE !!,"Accession list date: ",Z(1)," OK "
SET %=1
DO YN^LRU
if %<0
GOTO END
A IF %=2
WRITE !
SET %DT("A")="Select DATE: "
SET %DT="AQE"
DO ^%DT
KILL %DT
if Y<1
GOTO END
SET X=Y
DO D^LRU
SET Z(1)=Y
SET Y=X
+1 SET LRAD=$SELECT($PIECE(^LRO(68,LRAA,0),U,3)="Y":$EXTRACT(Y,1,3)_"0000",1:Y)
+2 IF '$DATA(^LRO(68,LRAA,1,LRAD,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)
GOTO END
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)
GOTO END
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)
GOTO END
if N(2)=""
SET N(2)=999999
IF N(2)'?1N.N
WRITE $CHAR(7),!!,"NUMBERS ONLY !!",!!
GOTO N2
+1 WRITE !!,"LIST BY PATIENT "
SET %=2
DO YN^LRU
if %=1
GOTO ^LRUPA2
if %<1
GOTO END
+2 IF "CHMI"[LRSS
WRITE !!,"LIST BY COLLECTION SAMPLE "
SET %=2
DO YN^LRU
if %<0
GOTO END
IF %=1
SET DIC=62
SET DIC(0)="AEMQ"
SET DIC("A")="Select COLLECTION SAMPLE: "
DO ^DIC
KILL DIC
if Y<1
GOTO END
SET C(1)=+Y
SET C=$PIECE(Y,U,2)
+3 SET ZTRTN="QUE^LRUPA"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
SET (Q(1),Q(2))=0
SET LRU(1)=+$ORDER(^LAB(62,"B","UNKNOWN",0))
DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
+1 SET N=N(1)-1
FOR B=0:0
SET N=$ORDER(^LRO(68,LRAA,1,LRAD,1,N))
if 'N!(N>N(2))!(LR("Q"))
QUIT
SET LRC(5)=$SELECT($DATA(^LRO(68,LRAA,1,LRAD,1,N,3)):$PIECE(^(3),"^",6),1:"")
DO ^LRUPA1
+2 if LR("Q")
QUIT
IF LRSS="CY"
if $Y>(IOSL-8)
DO H
if LR("Q")
QUIT
WRITE !?72,"-----",!,"Cell block (b) count: ",Q(1),?58,"Slide count:",?72,$JUSTIFY(Q(2),5)
+3 IF $GET(LRSS)="BB"
if IOST'?1"C".E
WRITE @IOF
+4 IF $GET(LRSS)'="BB"
Begin DoDot:1
+5 if IOST'?1"C".E&($EXTRACT(IOST,1,2)'="P-"!($DATA(LR("FORM"))))
WRITE @IOF
End DoDot:1
+6 DO END^LRUTL
DO END
+7 QUIT
H ;from LRUPA1
+1 IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
if LR("Q")
QUIT
+2 DO F^LRU
WRITE !,LRO(68)," ACCESSIONS for ",Z(1),!
if $DATA(C)#2
WRITE "Collection Sample: ",C,!
+3 WRITE "# = Not VA patient "
if LRSS="CY"
WRITE "* = Reviewed by pathologist"
if LRSS="CH"
WRITE ?30,"*=STAT"
WRITE ?55,$SELECT("SPCYEMAU"[LRSS:"% =Incomplete",1:"")
IF LRSS="CY"
WRITE ?72,"Slide"
+4 WRITE !,"Acc num",?12,$SELECT(LRSS="MI":"Patient/Source",1:"Patient"),?28,"ID",?34,"Loc"
IF "CYEMSP"[LRSS
WRITE ?48,"Organ/tissue",!,LR("%")
QUIT
+5 WRITE ?40
if "AUBBCYEMSP"'[LRSS
WRITE "Specimen/Sample"
if LRSS="BB"
WRITE "Specimen date"
IF LRSS="CY"
WRITE ?72,"Count"
+6 IF "BBCHMI"[LRSS
WRITE ?64,"Test",?76,"Tech",!,LR("%")
QUIT
+7 if LRSS="AU"
WRITE ?42,"Date/time of Autopsy"
WRITE !,LR("%")
QUIT
+8 ;
END DO V^LRU
QUIT
