- LRUPQ ;AVAMC/REG - LAB RESULTS BY ACCESSION AREA ;2/18/93 13:12 ;
- ;;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
- ;
- L S LR(4)="" F X=2:1:IOM S LR(4)=LR(4)_"-"
- Q
- ;
- END D V^LRU Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUPQ 1784 printed Jan 18, 2025@03:22:41 Page 2
- LRUPQ ;AVAMC/REG - LAB RESULTS BY ACCESSION AREA ;2/18/93 13:12 ;
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +2 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"
- +3 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
- +4 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
- +5 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 WRITE !,"Acc #",?7,"Patient",?28,"SSN",?35,"LOC",?41,"Specimen",?56,"Received",?68,"Verified",!,LR("%")
- QUIT
- +3 ;
- L SET LR(4)=""
- FOR X=2:1:IOM
- SET LR(4)=LR(4)_"-"
- +1 QUIT
- +2 ;
- END DO V^LRU
- QUIT