- 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 Feb 18, 2025@23:47:42 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
