LRUPAD ;AVAMC/REG/WTY - LAB ACCESSION LIST BY DATE ;DEC 09, 2008 8:30 AM
;;5.2;LAB SERVICE;**1002,1018,1025**;NOV 01, 1997
;;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
K C S %DT="",X="T" D ^%DT S (Q(1),Q(2),Z(4))=0 D D^LRU,EN^LRUTL S Z(1)=Y
S:'$D(LRO(68)) LRO(68)=LRAA(1) W !!?20,LRO(68)," ACCESSION LIST"
D B^LRU G:Y<0 END
S LRLDT=LRLDT+.99,X=$P(^LRO(68,LRAA,0),U,3),V(1)=$S(X="Y":$E(LRSDT,1,3)_"0000",1:LRSDT),V=$S(X="Y":$E(LRLDT,1,3)_"0000",1:LRLDT)
L W !!,"List by (A)ccession number (P)atient ",$S("CHMI"[LRSS:"(C)ollection Sample ",1:""),": " R X:DTIME G:X=""!(X[U) END I $A(X)'=65&($A(X)'=67)&($A(X)'=80) D S G L
I "AP"'[$E(X)&(X?1"C".E&("CHMI"'[LRSS)) D H G L
W:$L(X)=1 $S(X="P":"atient",X="A":"ccession number",1:"ollection Sample") G:X?1"P".E ^LRUPAD2
I X?1"C".E S DIC="62",DIC(0)="AEMOQ",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^LRUPAD" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO S LRU(1)=+$O(^LAB(62,"B","UNKNOWN",0)) D L^LRU,S^LRU,H S LR("F")=1
S V(1)=V(1)-1
F I=V(1):0 S I=$O(^LRO(68,LRAA,1,I)) Q:'I!(I>V)!(LR("Q")) S LRSA=LRSDT-.01 F B=LRSA:0 S B=$O(^LRO(68,LRAA,1,I,1,"E",B)) Q:'B!(B>LRLDT)!(LR("Q")) I $P(B,".")=I!($E(I,6,7)="00") D O
I 'LR("Q"),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)
W:IOST'?1"C".E&($E(IOST,1,2)'="P-"!($D(LR("FORM")))) @IOF
D END^LRUTL,END Q
O F N=0:0 S N=$O(^LRO(68,LRAA,1,I,1,"E",B,N)) Q:'N!(LR("Q")) S LRC(5)=$S($D(^LRO(68,LRAA,1,I,1,N,3)):$P(^(3),"^",6),1:"") D ^LRUPAD1
Q
H ;from LRUPAD1
I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU
W !,LRO(68)," (",LRSTR,"-",LRLST,")",! W:$D(C)#2 "Collection Sample: ",C,!
;W "# = Not VA patient ",$S(LRSS="CY":"* = Reviewed by pathologist",1:""),?57,$S("AUSPCYEMMI"[LRSS:"% =Incomplete",1:"")
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
W "# = Not IHS patient ",$S(LRSS="CY":"* = Reviewed by pathologist",1:""),?57,$S("AUSPCYEMMI"[LRSS:"% =Incomplete",1:"") ;IHS/ANMC/CLS 08/18/96
;----- EN DIHS MODIFICATIONS
W ?60,$S("CH"[LRSS:"%=Test not verified",1:"") I LRSS="CY" W ?72,"Slide"
; I "CHMI"[LRSS W ?62,"Test",?76,"Tech",!,LR("%") Q
W !,"Acc #",?8,"Date",?14,$S(LRSS="MI":"Patient/Source",1:"Patient"),?34,"ID",?40,"Loc" W:LRSS'="AU" ?46,$S("SPCYEM"[LRSS:"Physician",1:"Spec/sample") I LRSS="CY" W ?72,"Count"
; I "CHMI"[LRSS W ?62,"Test",?76,"Tech",!,LR("%") Q
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1025 MODIFICATION -- Need $G to prevent <UNDEFINED> error
I "CHMI"[LRSS W ?62,"Test",?76,"Tech",!,$G(LR("%")) Q
; ----- END IHS/OIT/MKK - LR*5.2*1025 MODIFICATION
W:LRSS="AU" ?46,"Date/time of Autopsy" W !,LR("%") Q
S W !!,"Enter following letter for appropriate listing:"
W !?5,"'A' for listing by accession number"
W !?5,"'P' for listing by patient"
W:"AUCYEMSP"'[LRSS !?5,"'C' for listing by collection sample"
Q
;
END D V^LRU Q
LRUPAD ;AVAMC/REG/WTY - LAB ACCESSION LIST BY DATE ;DEC 09, 2008 8:30 AM
+1 ;;5.2;LAB SERVICE;**1002,1018,1025**;NOV 01, 1997
+2 ;;5.2;LAB SERVICE;**72,248**;Sep 27, 1994
+3 ;
+4 ;Reference to ^%DT supported by IA #10003
+5 ;Reference to ^DIC supported by IA #10006
+6 ;
+7 IF '$DATA(LRAA)!('$DATA(LRAA(1)))
DO ^LRUBYDIV
IF '$DATA(Y)
GOTO END
+8 KILL C
SET %DT=""
SET X="T"
DO ^%DT
SET (Q(1),Q(2),Z(4))=0
DO D^LRU
DO EN^LRUTL
SET Z(1)=Y
+9 IF '$DATA(LRO(68))
SET LRO(68)=LRAA(1)
WRITE !!?20,LRO(68)," ACCESSION LIST"
+10 DO B^LRU
IF Y<0
GOTO END
+11 SET LRLDT=LRLDT+.99
SET X=$PIECE(^LRO(68,LRAA,0),U,3)
SET V(1)=$SELECT(X="Y":$EXTRACT(LRSDT,1,3)_"0000",1:LRSDT)
SET V=$SELECT(X="Y":$EXTRACT(LRLDT,1,3)_"0000",1:LRLDT)
L WRITE !!,"List by (A)ccession number (P)atient ",$SELECT("CHMI"[LRSS:"(C)ollection Sample ",1:""),": "
READ X:DTIME
IF X=""!(X[U)
GOTO END
IF $ASCII(X)'=65&($ASCII(X)'=67)&($ASCII(X)'=80)
DO S
GOTO L
+1 IF "AP"'[$EXTRACT(X)&(X?1"C".E&("CHMI"'[LRSS))
DO H
GOTO L
+2 IF $LENGTH(X)=1
WRITE $SELECT(X="P":"atient",X="A":"ccession number",1:"ollection Sample")
IF X?1"P".E
GOTO ^LRUPAD2
+3 IF X?1"C".E
SET DIC="62"
SET DIC(0)="AEMOQ"
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)
+4 SET ZTRTN="QUE^LRUPAD"
DO BEG^LRUTL
IF POP!($DATA(ZTSK))
GOTO END
QUE USE IO
SET LRU(1)=+$ORDER(^LAB(62,"B","UNKNOWN",0))
DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
+1 SET V(1)=V(1)-1
+2 FOR I=V(1):0
SET I=$ORDER(^LRO(68,LRAA,1,I))
IF 'I!(I>V)!(LR("Q"))
QUIT
SET LRSA=LRSDT-.01
FOR B=LRSA:0
SET B=$ORDER(^LRO(68,LRAA,1,I,1,"E",B))
IF 'B!(B>LRLDT)!(LR("Q"))
QUIT
IF $PIECE(B,".")=I!($EXTRACT(I,6,7)="00")
DO O
+3 IF 'LR("Q")
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)
+4 IF IOST'?1"C".E&($EXTRACT(IOST,1,2)'="P-"!($DATA(LR("FORM"))))
WRITE @IOF
+5 DO END^LRUTL
DO END
QUIT
O FOR N=0:0
SET N=$ORDER(^LRO(68,LRAA,1,I,1,"E",B,N))
IF 'N!(LR("Q"))
QUIT
SET LRC(5)=$SELECT($DATA(^LRO(68,LRAA,1,I,1,N,3)):$PIECE(^(3),"^",6),1:"")
DO ^LRUPAD1
+1 QUIT
H ;from LRUPAD1
+1 IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
IF LR("Q")
QUIT
+2 DO F^LRU
+3 WRITE !,LRO(68)," (",LRSTR,"-",LRLST,")",!
IF $DATA(C)#2
WRITE "Collection Sample: ",C,!
+4 ;W "# = Not VA patient ",$S">S(LRS">SS">S="CY":"* = Reviewed by pathologist",1:""),?57,$S">S("AUS">SPCYEMMI"[LRS">SS">S:"% =Incomplete",1:"")
+5 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+6 ;IHS/ANMC/CLS 08/18/96
WRITE "# = Not IHS patient ",$SELECT(LRSS="CY":"* = Reviewed by pathologist",1:""),?57,$SELECT("AUSPCYEMMI"[LRSS:"% =Incomplete",1:"")
+7 ;----- EN DIHS MODIFICATIONS
+8 WRITE ?60,$SELECT("CH"[LRSS:"%=Test not verified",1:"")
IF LRSS="CY"
WRITE ?72,"Slide"
+9 ; I "CHMI"[LRSS W ?62,"Test",?76,"Tech",!,LR("%") Q
+10 WRITE !,"Acc #",?8,"Date",?14,$SELECT(LRSS="MI":"Patient/Source",1:"Patient"),?34,"ID",?40,"Loc"
IF LRSS'="AU"
WRITE ?46,$SELECT("SPCYEM"[LRSS:"Physician",1:"Spec/sample")
IF LRSS="CY"
WRITE ?72,"Count"
+11 ; I "CHMI"[LRSS W ?62,"Test",?76,"Tech",!,LR("%") Q
+12 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1025 MODIFICATION -- Need $G to prevent <UNDEFINED> error
+13 IF "CHMI"[LRSS
WRITE ?62,"Test",?76,"Tech",!,$GET(LR("%"))
QUIT
+14 ; ----- END IHS/OIT/MKK - LR*5.2*1025 MODIFICATION
+15 IF LRSS="AU"
WRITE ?46,"Date/time of Autopsy"
WRITE !,LR("%")
QUIT
S WRITE !!,"Enter following letter for appropriate listing:"
+1 WRITE !?5,"'A' for listing by accession number"
+2 WRITE !?5,"'P' for listing by patient"
+3 IF "AUCYEMSP"'[LRSS
WRITE !?5,"'C' for listing by collection sample"
+4 QUIT
+5 ;
END DO V^LRU
QUIT
