LRGP ;DALOI/CJS/RWF - INSTRUMENT GROUP DELTA CHECK DISPLAY ;2/5/91 13:19
;;5.2;LAB SERVICE;**153,269**;Sep 27, 1994
;
N LASQ,LRPAGE,LRVBY
;
S LASQ=0,LRGVP="",LRDCNT=0
K ^TMP("LR",$J)
D ^LRPARAM
I $G(LREND) D CLOSE Q
D ^LRGP1
I $G(LREND) D CLOSE Q
;
S LRDCNT=0,%ZIS="Q"
D ^%ZIS
I POP D CLOSE Q
I $D(IO("Q")) D Q
. N ZTDTH,ZTRTN,ZTSAVE,ZTDESC
. K IO("Q")
. S ZTRTN="DQ^LRGP",ZTSAVE("LR*")="",ZTSAVE("^TMP(""LR"",$J,")="",ZTDESC="Group unverified review (EA, EL, EW)"
. D ^%ZTLOAD
. U IO(0) W !,"Task ",$S($G(ZTSK):ZTSK,1:"NOT")," Queued"
. D CLOSE
;
;
DQ ;
U IO
S LRNOW=$$NOW^XLFDT,LRDT=$$FMTE^XLFDT(LRNOW,"5MZ"),LRPAGE=0
D ACC:LRWT="A",LRTRAY:LRWT="T",MACHSQ:LRWT="M",WRKLST:LRWT="W"
W:'LRDCNT !!,"No data to report",!!
W:$E(IOST,1,2)="P-" @IOF
;
CLOSE ;
I $D(ZTQUEUED) S ZTREQ="@"
E D ^%ZISC
D ^LRGVK
Q
;
;
ACC ;
S LRHED="By Accession list: "_LRNAME D LRHED
S LRAN=LRFAN
F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:LRAN<1!(LRAN>LRLIX) D Q:$G(ZTSTOP)
. S LASQ=0
. D WRK2 Q:$G(ZTSTOP)
. D LRHED:$E(IOST,1,2)'="C-"&($Y+3>IOSL)
. I 'LASQ D
. . W !,"No Unverified instrument Data for Acc#: ",LRAN
. . D DASH^LRX
Q
;
;
LRHED ;
S LRPAGE=LRPAGE+1
W @IOF
W !,"Group unverified review listing",?50,"Page: ",LRPAGE
W !,LRHED,?50,"Date: ",LRDT,!!
Q
;
;
LRTRAY ;
S LRHED="By Tray. Load list: "_$P(^LRO(68.2,LRLL,0),U,1)
D LRHED
;
F LRTRAY=LRFTRAY:1:LRLTRAY W !!,"Start LRTRAY: ",LRTRAY D Q:$G(ZTSTOP)
. F LRCUP=LRFCUP:1:$S(LRTRAY=LRLTRAY:LRLCUP,1:LRMAXCUP) D Q:$G(ZTSTOP)
. . S LRITC=LRTRAY_";"_LRCUP,LRSQ=0
. . F S LRSQ=$O(^LAH(LRLL,1,"B",LRITC,LRSQ)) Q:LRSQ<1 D PRINT Q:$G(ZTSTOP)
Q
;
;
MACHSQ ;
S LRHED="By Machine Sequence number. Load/Work list: "_$P(^LRO(68.2,LRLL,0),U,1)
D LRHED
;
S LRSQ=LRSQ-1
F S LRSQ=$O(^LAH(LRLL,1,LRSQ)) Q:LRSQ<1!(LRSQ>LRESEQ) D PRINT Q:$G(ZTSTOP)
;
Q
;
;
WRKLST ;
S LRHED="By Work list: "_$P(^LRO(68.2,LRLL,0),U,1)
D LRHED
S LRC=LRCUP-1
F S LRC=$O(^LRO(68.2,LRLL,1,1,1,LRC)) Q:LRC<1!(LRC>LRECUP) D Q:$G(ZTSTOP)
. N LRX
. S LRX=$G(^LRO(68.2,LRLL,1,1,1,LRC,0))
. I LRX="" Q
. S LRAA=$P(LRX,"^"),LRAD=$P(LRX,"^",2),LRAN=$P(LRX,"^",3)
. D WRK2
Q
;
;
WRK2 ; Display results for each accession number.
;
S LRSQ=0
F S LRSQ=$O(^LAH(LRLL,1,"C",LRAN,LRSQ)) Q:LRSQ<1 D PRINT Q:$G(ZTSTOP)
Q
;
;
PRINT ;
; Check that results belong to same accession area and date since
; results can belong to different accession areas and dates but have
; the same acession number.
;
; Check if task has been asked to stop.
I $D(ZTQUEUED),$$S^%ZTLOAD D Q
. S ZTSTOP=1
. W !!,"*** Report requested to stop by TaskMan ***"
. W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
;
Q:'$D(^LAH(LRLL,1,LRSQ,0))
;
S LRSQ(0)=^LAH(LRLL,1,LRSQ,0)
;
; Different accession area
I $P(LRSQ(0),"^",3),LRAA'=$P(LRSQ(0),"^",3) Q
; Different accession date
I $P(LRSQ(0),"^",4),LRAD'=$P(LRSQ(0),"^",4) Q
;
D LRHED:$E(IOST,1,2)'="C-"&($Y+LRVTS>IOSL)
W !!,?4,"Seq #: ",LRSQ
S LRTRAY=$P(LRSQ(0),"^",1),LRCUP=$P(LRSQ(0),"^",2)
I $L(LRTRAY) W ?43,"Tray: ",LRTRAY
I $L(LRCUP) W ?51," Cup: ",LRCUP
;
;
Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
;
S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRORD=$S($D(^(.1)):^(.1),1:0),LRODT=$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=$P(^(0),U,5)
Q:LRSN<1
;
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
D PT^LRX
D DISPLAY
D VER^LRVR1
D DASH^LRX
S LRDCNT=LRDCNT+1,LASQ=1
Q
;
;
DISPLAY ; Display accession info/results
W !,?5,"Name: ",PNM,?44,"SSN: ",SSN
W:LRORD !," Order #: ",LRORD
;
W !,"Accession: ",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^")
I $P(LRSQ(0),"^",10) W ?30," Results received: ",$$FMTE^XLFDT($P(LRSQ(0),"^",10),"1M")
W !,?6,"UID: ",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3),"UNKNOWN"),"^")
I $P(LRSQ(0),"^",11) W ?34," Last updated: ",$$FMTE^XLFDT($P(LRSQ(0),"^",11),"1M")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRGP 4022 printed Dec 13, 2024@02:14:55 Page 2
LRGP ;DALOI/CJS/RWF - INSTRUMENT GROUP DELTA CHECK DISPLAY ;2/5/91 13:19
+1 ;;5.2;LAB SERVICE;**153,269**;Sep 27, 1994
+2 ;
+3 NEW LASQ,LRPAGE,LRVBY
+4 ;
+5 SET LASQ=0
SET LRGVP=""
SET LRDCNT=0
+6 KILL ^TMP("LR",$JOB)
+7 DO ^LRPARAM
+8 IF $GET(LREND)
DO CLOSE
QUIT
+9 DO ^LRGP1
+10 IF $GET(LREND)
DO CLOSE
QUIT
+11 ;
+12 SET LRDCNT=0
SET %ZIS="Q"
+13 DO ^%ZIS
+14 IF POP
DO CLOSE
QUIT
+15 IF $DATA(IO("Q"))
Begin DoDot:1
+16 NEW ZTDTH,ZTRTN,ZTSAVE,ZTDESC
+17 KILL IO("Q")
+18 SET ZTRTN="DQ^LRGP"
SET ZTSAVE("LR*")=""
SET ZTSAVE("^TMP(""LR"",$J,")=""
SET ZTDESC="Group unverified review (EA, EL, EW)"
+19 DO ^%ZTLOAD
+20 USE IO(0)
WRITE !,"Task ",$SELECT($GET(ZTSK):ZTSK,1:"NOT")," Queued"
+21 DO CLOSE
End DoDot:1
QUIT
+22 ;
+23 ;
DQ ;
+1 USE IO
+2 SET LRNOW=$$NOW^XLFDT
SET LRDT=$$FMTE^XLFDT(LRNOW,"5MZ")
SET LRPAGE=0
+3 if LRWT="A"
DO ACC
if LRWT="T"
DO LRTRAY
if LRWT="M"
DO MACHSQ
if LRWT="W"
DO WRKLST
+4 if 'LRDCNT
WRITE !!,"No data to report",!!
+5 if $EXTRACT(IOST,1,2)="P-"
WRITE @IOF
+6 ;
CLOSE ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF '$TEST
DO ^%ZISC
+3 DO ^LRGVK
+4 QUIT
+5 ;
+6 ;
ACC ;
+1 SET LRHED="By Accession list: "_LRNAME
DO LRHED
+2 SET LRAN=LRFAN
+3 FOR
SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))
if LRAN<1!(LRAN>LRLIX)
QUIT
Begin DoDot:1
+4 SET LASQ=0
+5 DO WRK2
if $GET(ZTSTOP)
QUIT
+6 if $EXTRACT(IOST,1,2)'="C-"&($Y+3>IOSL)
DO LRHED
+7 IF 'LASQ
Begin DoDot:2
+8 WRITE !,"No Unverified instrument Data for Acc#: ",LRAN
+9 DO DASH^LRX
End DoDot:2
End DoDot:1
if $GET(ZTSTOP)
QUIT
+10 QUIT
+11 ;
+12 ;
LRHED ;
+1 SET LRPAGE=LRPAGE+1
+2 WRITE @IOF
+3 WRITE !,"Group unverified review listing",?50,"Page: ",LRPAGE
+4 WRITE !,LRHED,?50,"Date: ",LRDT,!!
+5 QUIT
+6 ;
+7 ;
LRTRAY ;
+1 SET LRHED="By Tray. Load list: "_$PIECE(^LRO(68.2,LRLL,0),U,1)
+2 DO LRHED
+3 ;
+4 FOR LRTRAY=LRFTRAY:1:LRLTRAY
WRITE !!,"Start LRTRAY: ",LRTRAY
Begin DoDot:1
+5 FOR LRCUP=LRFCUP:1:$SELECT(LRTRAY=LRLTRAY:LRLCUP,1:LRMAXCUP)
Begin DoDot:2
+6 SET LRITC=LRTRAY_";"_LRCUP
SET LRSQ=0
+7 FOR
SET LRSQ=$ORDER(^LAH(LRLL,1,"B",LRITC,LRSQ))
if LRSQ<1
QUIT
DO PRINT
if $GET(ZTSTOP)
QUIT
End DoDot:2
if $GET(ZTSTOP)
QUIT
End DoDot:1
if $GET(ZTSTOP)
QUIT
+8 QUIT
+9 ;
+10 ;
MACHSQ ;
+1 SET LRHED="By Machine Sequence number. Load/Work list: "_$PIECE(^LRO(68.2,LRLL,0),U,1)
+2 DO LRHED
+3 ;
+4 SET LRSQ=LRSQ-1
+5 FOR
SET LRSQ=$ORDER(^LAH(LRLL,1,LRSQ))
if LRSQ<1!(LRSQ>LRESEQ)
QUIT
DO PRINT
if $GET(ZTSTOP)
QUIT
+6 ;
+7 QUIT
+8 ;
+9 ;
WRKLST ;
+1 SET LRHED="By Work list: "_$PIECE(^LRO(68.2,LRLL,0),U,1)
+2 DO LRHED
+3 SET LRC=LRCUP-1
+4 FOR
SET LRC=$ORDER(^LRO(68.2,LRLL,1,1,1,LRC))
if LRC<1!(LRC>LRECUP)
QUIT
Begin DoDot:1
+5 NEW LRX
+6 SET LRX=$GET(^LRO(68.2,LRLL,1,1,1,LRC,0))
+7 IF LRX=""
QUIT
+8 SET LRAA=$PIECE(LRX,"^")
SET LRAD=$PIECE(LRX,"^",2)
SET LRAN=$PIECE(LRX,"^",3)
+9 DO WRK2
End DoDot:1
if $GET(ZTSTOP)
QUIT
+10 QUIT
+11 ;
+12 ;
WRK2 ; Display results for each accession number.
+1 ;
+2 SET LRSQ=0
+3 FOR
SET LRSQ=$ORDER(^LAH(LRLL,1,"C",LRAN,LRSQ))
if LRSQ<1
QUIT
DO PRINT
if $GET(ZTSTOP)
QUIT
+4 QUIT
+5 ;
+6 ;
PRINT ;
+1 ; Check that results belong to same accession area and date since
+2 ; results can belong to different accession areas and dates but have
+3 ; the same acession number.
+4 ;
+5 ; Check if task has been asked to stop.
+6 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
Begin DoDot:1
+7 SET ZTSTOP=1
+8 WRITE !!,"*** Report requested to stop by TaskMan ***"
+9 WRITE !,"*** Task #",$GET(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($HOROLOG)," ***"
End DoDot:1
QUIT
+10 ;
+11 if '$DATA(^LAH(LRLL,1,LRSQ,0))
QUIT
+12 ;
+13 SET LRSQ(0)=^LAH(LRLL,1,LRSQ,0)
+14 ;
+15 ; Different accession area
+16 IF $PIECE(LRSQ(0),"^",3)
IF LRAA'=$PIECE(LRSQ(0),"^",3)
QUIT
+17 ; Different accession date
+18 IF $PIECE(LRSQ(0),"^",4)
IF LRAD'=$PIECE(LRSQ(0),"^",4)
QUIT
+19 ;
+20 if $EXTRACT(IOST,1,2)'="C-"&($Y+LRVTS>IOSL)
DO LRHED
+21 WRITE !!,?4,"Seq #: ",LRSQ
+22 SET LRTRAY=$PIECE(LRSQ(0),"^",1)
SET LRCUP=$PIECE(LRSQ(0),"^",2)
+23 IF $LENGTH(LRTRAY)
WRITE ?43,"Tray: ",LRTRAY
+24 IF $LENGTH(LRCUP)
WRITE ?51," Cup: ",LRCUP
+25 ;
+26 ;
+27 if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
QUIT
+28 ;
+29 SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRORD=$SELECT($DATA(^(.1)):^(.1),1:0)
SET LRODT=$SELECT($PIECE(^(0),U,4):$PIECE(^(0),U,4),1:$PIECE(^(0),U,3))
SET LRSN=$PIECE(^(0),U,5)
+30 if LRSN<1
QUIT
+31 ;
+32 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
+33 DO PT^LRX
+34 DO DISPLAY
+35 DO VER^LRVR1
+36 DO DASH^LRX
+37 SET LRDCNT=LRDCNT+1
SET LASQ=1
+38 QUIT
+39 ;
+40 ;
DISPLAY ; Display accession info/results
+1 WRITE !,?5,"Name: ",PNM,?44,"SSN: ",SSN
+2 if LRORD
WRITE !," Order #: ",LRORD
+3 ;
+4 WRITE !,"Accession: ",$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^")
+5 IF $PIECE(LRSQ(0),"^",10)
WRITE ?30," Results received: ",$$FMTE^XLFDT($PIECE(LRSQ(0),"^",10),"1M")
+6 WRITE !,?6,"UID: ",$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3),"UNKNOWN"),"^")
+7 IF $PIECE(LRSQ(0),"^",11)
WRITE ?34," Last updated: ",$$FMTE^XLFDT($PIECE(LRSQ(0),"^",11),"1M")
+8 ;
+9 QUIT
