- 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
