- LRGV ;DALIO/RWF - INSTRUMENT GROUP VERIFY DATA ;2/5/91 13:26
- ;;5.2;LAB SERVICE;**269,411,519**;Sep 27, 1994;Build 16
- ;
- N LRANYAA,LRDUZ,LRUID,LRVBY,LRGVP
- ;
- D ^LRGVK,^LRPARAM
- I $G(LREND) D END Q
- ;
- S U="^",LRSS="CH",LROUTINE=$P(^LAB(69.9,1,3),U,2),(LRANYAA,LRUID,LRVBY)=""
- ;
- ; Get user's initials to use to verify results
- S X=DUZ D DUZ^LRX
- X ^%ZOSF("EOFF")
- N DIR
- S DIR(0)="FAO^1:10",DIR("A")="Please enter your initials to verify: "
- D ^DIR K DIR
- X ^%ZOSF("EON")
- I $D(DIRUT)!(Y'=LRUSI) D END Q
- ;
- D ^LRGP1
- I LREND D END Q
- ;
- D COM
- I LREND D NOP,END Q
- ;
- S %ZIS="Q" D ^%ZIS
- I POP D END Q
- ;
- I $D(IO("Q")) D Q
- . N ZTDTH,ZTRTN,ZTSAVE,ZTDESC
- . K IO("Q")
- . ;LRGVP = indicates to downstream routines that sending to a printer
- . S LRGVP=1
- . S ZTRTN="DQ^LRGV",ZTSAVE("LR*")="",ZTSAVE("^TMP(""LR"",$J,")="",ZTDESC="Group verify (EA, EL, EW)"
- . D ^%ZTLOAD
- . U IO(0) W !,"Task ",$S($G(ZTSK):ZTSK,1:"NOT")," Queued"
- . D END
- ;
- DQ ;
- U IO
- S LRNOW=$$NOW^XLFDT,LRDT=$$FMTE^XLFDT(LRNOW,"1M"),(LREND,LRPAGE)=0
- S LRLLNM=$P(^LRO(68.2,LRLL,0),"^")
- D HDR
- D LRTRAY:LRWT="T",ACCLST:LRWT="A",SEQ:LRWT="M",WRKLST:LRWT="W"
- I $E(IOST,1,2)="P-" W @IOF
- ;
- END ;
- I $D(ZTQUEUED) S ZTREQ="@"
- E D ^%ZISC
- D ^LRGVK
- K LRCSQQ,LRLLNM,LRNGS,LRPAGE
- Q
- ;
- ;
- ACCLST ; Verify by accession number/UID
- ;
- S LRVWLE=""
- ;
- ; Verify by accession number
- I LRVBY=1 D
- . S LRAN=LRFAN
- . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:LRAN<1!(LRAN>LRLIX) D ACC2 Q:LREND
- . I $L(LRVWLE) D
- . . S $P(^LRO(68,LRAA,1,LRAD,2),"^")=LRUSI
- . . S $P(^LRO(68,LRAA,1,LRAD,2),"^",4)=LRVWLE
- ;
- ; Verify by UID
- I LRVBY=2 D
- . S LRANYAA=+$P($G(^LRO(68.2,LRLL,10,LRPROF,0)),"^",3),LRUID=""
- . F D NEXT^LRVRA Q:LRUID="" D ACC2 Q:LREND
- ;
- Q
- ;
- ;
- ACC2 ; Only select those entries in ^LAH that match the accession area and
- ; date selected by the user.
- ;
- I $Y>(IOSL-10) D HDR Q:LREND
- W ! D DASH^LRX
- W !,"Accession #: ",LRAN
- I LRVBY=2 D
- . W " [UID: ",LRUID,"]"
- . I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D Q
- . . W " No accession on file for this UID."
- . W " <",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^"),">"
- ;
- I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",3) D Q
- . W " Has not been received. Unable to verify."
- ;
- I +^LRO(68,LRAA,1,LRAD,1,LRAN,3)>$$NOW^XLFDT D Q
- . W " Has a collection time in the future. Unable to verify."
- ;
- I $O(^LAH(LRLL,1,"C",LRAN,0))<1 D Q
- . W " NO Instrument Data Found."
- ;
- S LRSQ=0
- F S LRSQ=$O(^LAH(LRLL,1,"C",LRAN,LRSQ)) Q:LRSQ<1 D Q:LREND
- . S X=^LAH(LRLL,1,LRSQ,0)
- . I LRAA'=$P(X,"^",3)!(LRAD'=$P(X,"^",4)) Q
- . S LRAN=$P(X,"^",5)
- . I LRAN D STUFF^LRGV1
- Q
- ;
- ;
- LRTRAY ; Verify by tray/cup
- ;
- F LRTRAY=LRFTRAY:1:LRLTRAY D Q:LREND
- . I $Y>(IOSL-10) D HDR Q:LREND
- . W ! D DASH^LRX
- . W !!,"Start TRAY: ",LRTRAY
- . D TR2
- Q
- ;
- ;
- TR2 ; Verify by tray/cup
- ; Only select those entries in ^LAH that match the accession area and date
- ; selected by the user.
- N LRSC,LREC,X
- ;
- ; Figure out starting and ending cups for this tray
- S LRSC=$S(LRTRAY=LRFTRAY:LRFCUP,1:1)
- S LREC=$S(LRTRAY=LRLTRAY:LRLCUP,1:LRMAXCUP)
- ;
- F LRCUP=LRSC:1:LREC D Q:LREND
- . S LRITC=LRTRAY_";"_LRCUP
- . I $Y>(IOSL-10) D HDR Q:LREND
- . W ! D DASH^LRX
- . W !,"Tray ",$J(LRTRAY,3)," Cup ",$J(LRCUP,3)
- . I $O(^LAH(LRLL,1,"B",LRITC,0))<1 W ?35,"No Instrument Data Found" Q
- . ;
- . S LRSQ=0
- . F S LRSQ=$O(^LAH(LRLL,1,"B",LRITC,LRSQ)) Q:LRSQ<1 D Q:LREND
- . . I '$D(^LAH(LRLL,1,+LRSQ,0)) D Q
- . . . K ^LAH(LRLL,1,"B",LRTIC,LRSQ)
- . . . W ?35,"No Instrument Data Found"
- . . S X=^LAH(LRLL,1,LRSQ,0)
- . . I LRAA'=$P(X,"^",3)!(LRAD'=$P(X,"^",4)) Q
- . . S LRAN=$P(X,"^",5)
- . . I LRAN D STUFF^LRGV1 Q
- . . W ?35," Does not have a link to an Accession."
- Q
- ;
- ;
- SEQ ; Verify by sequence number
- ; Only select those entries in ^LAH that match the accession area and date
- ; selected by the user.
- ;
- N X
- ;
- S LRSQ=LRSQ-1
- F S LRSQ=$O(^LAH(LRLL,1,LRSQ)) Q:LRSQ<1!(LRSQ>LRESEQ) D Q:LREND
- . I $Y>(IOSL-10) D HDR Q:LREND
- . W ! D DASH^LRX
- . S X=^LAH(LRLL,1,LRSQ,0)
- . I LRAA'=$P(X,"^",3)!(LRAD'=$P(X,"^",4)) Q
- . S LRAN=$P(X,"^",5)
- . I LRAN D STUFF^LRGV1 Q
- . W !!,"SEQ: ",LRSQ,". Does not have a link to an Accession."
- Q
- ;
- ;
- WRKLST ; Verify by worklist
- ; Only select those entries in file #68.2 that match the profile selected
- ; by the user.
- ;
- N X
- ;
- S LRCUP=LRCUP-1
- F S LRCUP=$O(^LRO(68.2,LRLL,1,1,1,LRCUP)) Q:'LRCUP!(LRCUP>LRECUP) D Q:LREND
- . I $Y>(IOSL-10) D HDR Q:LREND
- . W ! D DASH^LRX
- . S X=^LRO(68.2,LRLL,1,1,1,LRCUP,0)
- . I $P(X,"^",4),$P(X,"^",4)'=LRPROF Q
- . S LRAA=$P(X,"^"),LRAD=$P(X,"^",2),LRAN=$P(X,"^",3)
- . W !,"Sequence #",$J(LRCUP,4)
- . I $O(^LAH(LRLL,1,"C",+LRAN,0))<1 W ?35,"No Instrument Data Found" Q
- . ;
- . S LRSQ=0
- . F S LRSQ=$O(^LAH(LRLL,1,"C",LRAN,LRSQ)) Q:LRSQ<1 D STUFF^LRGV1 Q:LREND
- Q
- ;
- ;
- COM ; Ask common questions
- ;
- N DIR,DIRUT,DTOUT,DUOUT,X,Y
- ;
- S LRVRFYAL=0
- I $D(^XUSEC("LRSUPER",DUZ))!1 D
- . S DIR(0)="YAO",DIR("B")="NO"
- . S DIR("A",1)="Verify accessions specified, even if"
- . S DIR("A")=" DELTA check or CRITICAL range flag? "
- . D ^DIR
- . I $D(DIRUT) S LREND=1 Q
- . S LRVRFYAL=Y
- ;
- I LREND Q
- ;
- K DIR
- S DIR(0)="YO",DIR("A")="Everything OK",DIR("B")="YES"
- D ^DIR
- I $D(DIRUT)!(Y'=1) S LREND=1
- Q
- ;
- ;
- NOP ;
- W !!,"NOTHING VERIFIED"
- Q
- ;
- ;
- HDR ;
- ;
- N DIR,DIRUT,DTOUT,DUOUT,X,Y
- ;
- I $E(IOST,1,2)="C-",'$D(ZTQUEUED),LRPAGE D
- . S DIR(0)="E" D ^DIR
- . I $D(DIRUT) S LREND=1
- I LREND Q
- ;
- I LRPAGE!($E(IOST,1,2)="C-") W @IOF
- S LRPAGE=LRPAGE+1
- W "Group verification report - Verify with",$S(LRVRFYAL:"",1:"out")," flags"
- W ?(IOM-27)," Date: ",LRDT
- W !,"Load/Work list: ",LRLLNM," Panel: ",LRPANEL,?(IOM-27)," Page: ",LRPAGE
- ;
- ; Check if task has been asked to stop.
- I $D(ZTQUEUED),$$S^%ZTLOAD D Q
- . S (LREND,ZTSTOP)=1
- . W !!,"*** Report requested to stop by TaskMan ***"
- . W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRGV 6063 printed Jan 18, 2025@03:15:40 Page 2
- LRGV ;DALIO/RWF - INSTRUMENT GROUP VERIFY DATA ;2/5/91 13:26
- +1 ;;5.2;LAB SERVICE;**269,411,519**;Sep 27, 1994;Build 16
- +2 ;
- +3 NEW LRANYAA,LRDUZ,LRUID,LRVBY,LRGVP
- +4 ;
- +5 DO ^LRGVK
- DO ^LRPARAM
- +6 IF $GET(LREND)
- DO END
- QUIT
- +7 ;
- +8 SET U="^"
- SET LRSS="CH"
- SET LROUTINE=$PIECE(^LAB(69.9,1,3),U,2)
- SET (LRANYAA,LRUID,LRVBY)=""
- +9 ;
- +10 ; Get user's initials to use to verify results
- +11 SET X=DUZ
- DO DUZ^LRX
- +12 XECUTE ^%ZOSF("EOFF")
- +13 NEW DIR
- +14 SET DIR(0)="FAO^1:10"
- SET DIR("A")="Please enter your initials to verify: "
- +15 DO ^DIR
- KILL DIR
- +16 XECUTE ^%ZOSF("EON")
- +17 IF $DATA(DIRUT)!(Y'=LRUSI)
- DO END
- QUIT
- +18 ;
- +19 DO ^LRGP1
- +20 IF LREND
- DO END
- QUIT
- +21 ;
- +22 DO COM
- +23 IF LREND
- DO NOP
- DO END
- QUIT
- +24 ;
- +25 SET %ZIS="Q"
- DO ^%ZIS
- +26 IF POP
- DO END
- QUIT
- +27 ;
- +28 IF $DATA(IO("Q"))
- Begin DoDot:1
- +29 NEW ZTDTH,ZTRTN,ZTSAVE,ZTDESC
- +30 KILL IO("Q")
- +31 ;LRGVP = indicates to downstream routines that sending to a printer
- +32 SET LRGVP=1
- +33 SET ZTRTN="DQ^LRGV"
- SET ZTSAVE("LR*")=""
- SET ZTSAVE("^TMP(""LR"",$J,")=""
- SET ZTDESC="Group verify (EA, EL, EW)"
- +34 DO ^%ZTLOAD
- +35 USE IO(0)
- WRITE !,"Task ",$SELECT($GET(ZTSK):ZTSK,1:"NOT")," Queued"
- +36 DO END
- End DoDot:1
- QUIT
- +37 ;
- DQ ;
- +1 USE IO
- +2 SET LRNOW=$$NOW^XLFDT
- SET LRDT=$$FMTE^XLFDT(LRNOW,"1M")
- SET (LREND,LRPAGE)=0
- +3 SET LRLLNM=$PIECE(^LRO(68.2,LRLL,0),"^")
- +4 DO HDR
- +5 if LRWT="T"
- DO LRTRAY
- if LRWT="A"
- DO ACCLST
- if LRWT="M"
- DO SEQ
- if LRWT="W"
- DO WRKLST
- +6 IF $EXTRACT(IOST,1,2)="P-"
- WRITE @IOF
- +7 ;
- END ;
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 IF '$TEST
- DO ^%ZISC
- +3 DO ^LRGVK
- +4 KILL LRCSQQ,LRLLNM,LRNGS,LRPAGE
- +5 QUIT
- +6 ;
- +7 ;
- ACCLST ; Verify by accession number/UID
- +1 ;
- +2 SET LRVWLE=""
- +3 ;
- +4 ; Verify by accession number
- +5 IF LRVBY=1
- Begin DoDot:1
- +6 SET LRAN=LRFAN
- +7 FOR
- SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))
- if LRAN<1!(LRAN>LRLIX)
- QUIT
- DO ACC2
- if LREND
- QUIT
- +8 IF $LENGTH(LRVWLE)
- Begin DoDot:2
- +9 SET $PIECE(^LRO(68,LRAA,1,LRAD,2),"^")=LRUSI
- +10 SET $PIECE(^LRO(68,LRAA,1,LRAD,2),"^",4)=LRVWLE
- End DoDot:2
- End DoDot:1
- +11 ;
- +12 ; Verify by UID
- +13 IF LRVBY=2
- Begin DoDot:1
- +14 SET LRANYAA=+$PIECE($GET(^LRO(68.2,LRLL,10,LRPROF,0)),"^",3)
- SET LRUID=""
- +15 FOR
- DO NEXT^LRVRA
- if LRUID=""
- QUIT
- DO ACC2
- if LREND
- QUIT
- End DoDot:1
- +16 ;
- +17 QUIT
- +18 ;
- +19 ;
- ACC2 ; Only select those entries in ^LAH that match the accession area and
- +1 ; date selected by the user.
- +2 ;
- +3 IF $Y>(IOSL-10)
- DO HDR
- if LREND
- QUIT
- +4 WRITE !
- DO DASH^LRX
- +5 WRITE !,"Accession #: ",LRAN
- +6 IF LRVBY=2
- Begin DoDot:1
- +7 WRITE " [UID: ",LRUID,"]"
- +8 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
- Begin DoDot:2
- +9 WRITE " No accession on file for this UID."
- End DoDot:2
- QUIT
- +10 WRITE " <",$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^"),">"
- End DoDot:1
- +11 ;
- +12 IF '$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",3)
- Begin DoDot:1
- +13 WRITE " Has not been received. Unable to verify."
- End DoDot:1
- QUIT
- +14 ;
- +15 IF +^LRO(68,LRAA,1,LRAD,1,LRAN,3)>$$NOW^XLFDT
- Begin DoDot:1
- +16 WRITE " Has a collection time in the future. Unable to verify."
- End DoDot:1
- QUIT
- +17 ;
- +18 IF $ORDER(^LAH(LRLL,1,"C",LRAN,0))<1
- Begin DoDot:1
- +19 WRITE " NO Instrument Data Found."
- End DoDot:1
- QUIT
- +20 ;
- +21 SET LRSQ=0
- +22 FOR
- SET LRSQ=$ORDER(^LAH(LRLL,1,"C",LRAN,LRSQ))
- if LRSQ<1
- QUIT
- Begin DoDot:1
- +23 SET X=^LAH(LRLL,1,LRSQ,0)
- +24 IF LRAA'=$PIECE(X,"^",3)!(LRAD'=$PIECE(X,"^",4))
- QUIT
- +25 SET LRAN=$PIECE(X,"^",5)
- +26 IF LRAN
- DO STUFF^LRGV1
- End DoDot:1
- if LREND
- QUIT
- +27 QUIT
- +28 ;
- +29 ;
- LRTRAY ; Verify by tray/cup
- +1 ;
- +2 FOR LRTRAY=LRFTRAY:1:LRLTRAY
- Begin DoDot:1
- +3 IF $Y>(IOSL-10)
- DO HDR
- if LREND
- QUIT
- +4 WRITE !
- DO DASH^LRX
- +5 WRITE !!,"Start TRAY: ",LRTRAY
- +6 DO TR2
- End DoDot:1
- if LREND
- QUIT
- +7 QUIT
- +8 ;
- +9 ;
- TR2 ; Verify by tray/cup
- +1 ; Only select those entries in ^LAH that match the accession area and date
- +2 ; selected by the user.
- +3 NEW LRSC,LREC,X
- +4 ;
- +5 ; Figure out starting and ending cups for this tray
- +6 SET LRSC=$SELECT(LRTRAY=LRFTRAY:LRFCUP,1:1)
- +7 SET LREC=$SELECT(LRTRAY=LRLTRAY:LRLCUP,1:LRMAXCUP)
- +8 ;
- +9 FOR LRCUP=LRSC:1:LREC
- Begin DoDot:1
- +10 SET LRITC=LRTRAY_";"_LRCUP
- +11 IF $Y>(IOSL-10)
- DO HDR
- if LREND
- QUIT
- +12 WRITE !
- DO DASH^LRX
- +13 WRITE !,"Tray ",$JUSTIFY(LRTRAY,3)," Cup ",$JUSTIFY(LRCUP,3)
- +14 IF $ORDER(^LAH(LRLL,1,"B",LRITC,0))<1
- WRITE ?35,"No Instrument Data Found"
- QUIT
- +15 ;
- +16 SET LRSQ=0
- +17 FOR
- SET LRSQ=$ORDER(^LAH(LRLL,1,"B",LRITC,LRSQ))
- if LRSQ<1
- QUIT
- Begin DoDot:2
- +18 IF '$DATA(^LAH(LRLL,1,+LRSQ,0))
- Begin DoDot:3
- +19 KILL ^LAH(LRLL,1,"B",LRTIC,LRSQ)
- +20 WRITE ?35,"No Instrument Data Found"
- End DoDot:3
- QUIT
- +21 SET X=^LAH(LRLL,1,LRSQ,0)
- +22 IF LRAA'=$PIECE(X,"^",3)!(LRAD'=$PIECE(X,"^",4))
- QUIT
- +23 SET LRAN=$PIECE(X,"^",5)
- +24 IF LRAN
- DO STUFF^LRGV1
- QUIT
- +25 WRITE ?35," Does not have a link to an Accession."
- End DoDot:2
- if LREND
- QUIT
- End DoDot:1
- if LREND
- QUIT
- +26 QUIT
- +27 ;
- +28 ;
- SEQ ; Verify by sequence number
- +1 ; Only select those entries in ^LAH that match the accession area and date
- +2 ; selected by the user.
- +3 ;
- +4 NEW X
- +5 ;
- +6 SET LRSQ=LRSQ-1
- +7 FOR
- SET LRSQ=$ORDER(^LAH(LRLL,1,LRSQ))
- if LRSQ<1!(LRSQ>LRESEQ)
- QUIT
- Begin DoDot:1
- +8 IF $Y>(IOSL-10)
- DO HDR
- if LREND
- QUIT
- +9 WRITE !
- DO DASH^LRX
- +10 SET X=^LAH(LRLL,1,LRSQ,0)
- +11 IF LRAA'=$PIECE(X,"^",3)!(LRAD'=$PIECE(X,"^",4))
- QUIT
- +12 SET LRAN=$PIECE(X,"^",5)
- +13 IF LRAN
- DO STUFF^LRGV1
- QUIT
- +14 WRITE !!,"SEQ: ",LRSQ,". Does not have a link to an Accession."
- End DoDot:1
- if LREND
- QUIT
- +15 QUIT
- +16 ;
- +17 ;
- WRKLST ; Verify by worklist
- +1 ; Only select those entries in file #68.2 that match the profile selected
- +2 ; by the user.
- +3 ;
- +4 NEW X
- +5 ;
- +6 SET LRCUP=LRCUP-1
- +7 FOR
- SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,1,1,LRCUP))
- if 'LRCUP!(LRCUP>LRECUP)
- QUIT
- Begin DoDot:1
- +8 IF $Y>(IOSL-10)
- DO HDR
- if LREND
- QUIT
- +9 WRITE !
- DO DASH^LRX
- +10 SET X=^LRO(68.2,LRLL,1,1,1,LRCUP,0)
- +11 IF $PIECE(X,"^",4)
- IF $PIECE(X,"^",4)'=LRPROF
- QUIT
- +12 SET LRAA=$PIECE(X,"^")
- SET LRAD=$PIECE(X,"^",2)
- SET LRAN=$PIECE(X,"^",3)
- +13 WRITE !,"Sequence #",$JUSTIFY(LRCUP,4)
- +14 IF $ORDER(^LAH(LRLL,1,"C",+LRAN,0))<1
- WRITE ?35,"No Instrument Data Found"
- QUIT
- +15 ;
- +16 SET LRSQ=0
- +17 FOR
- SET LRSQ=$ORDER(^LAH(LRLL,1,"C",LRAN,LRSQ))
- if LRSQ<1
- QUIT
- DO STUFF^LRGV1
- if LREND
- QUIT
- End DoDot:1
- if LREND
- QUIT
- +18 QUIT
- +19 ;
- +20 ;
- COM ; Ask common questions
- +1 ;
- +2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +3 ;
- +4 SET LRVRFYAL=0
- +5 IF $DATA(^XUSEC("LRSUPER",DUZ))!1
- Begin DoDot:1
- +6 SET DIR(0)="YAO"
- SET DIR("B")="NO"
- +7 SET DIR("A",1)="Verify accessions specified, even if"
- +8 SET DIR("A")=" DELTA check or CRITICAL range flag? "
- +9 DO ^DIR
- +10 IF $DATA(DIRUT)
- SET LREND=1
- QUIT
- +11 SET LRVRFYAL=Y
- End DoDot:1
- +12 ;
- +13 IF LREND
- QUIT
- +14 ;
- +15 KILL DIR
- +16 SET DIR(0)="YO"
- SET DIR("A")="Everything OK"
- SET DIR("B")="YES"
- +17 DO ^DIR
- +18 IF $DATA(DIRUT)!(Y'=1)
- SET LREND=1
- +19 QUIT
- +20 ;
- +21 ;
- NOP ;
- +1 WRITE !!,"NOTHING VERIFIED"
- +2 QUIT
- +3 ;
- +4 ;
- HDR ;
- +1 ;
- +2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +3 ;
- +4 IF $EXTRACT(IOST,1,2)="C-"
- IF '$DATA(ZTQUEUED)
- IF LRPAGE
- Begin DoDot:1
- +5 SET DIR(0)="E"
- DO ^DIR
- +6 IF $DATA(DIRUT)
- SET LREND=1
- End DoDot:1
- +7 IF LREND
- QUIT
- +8 ;
- +9 IF LRPAGE!($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- +10 SET LRPAGE=LRPAGE+1
- +11 WRITE "Group verification report - Verify with",$SELECT(LRVRFYAL:"",1:"out")," flags"
- +12 WRITE ?(IOM-27)," Date: ",LRDT
- +13 WRITE !,"Load/Work list: ",LRLLNM," Panel: ",LRPANEL,?(IOM-27)," Page: ",LRPAGE
- +14 ;
- +15 ; Check if task has been asked to stop.
- +16 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- Begin DoDot:1
- +17 SET (LREND,ZTSTOP)=1
- +18 WRITE !!,"*** Report requested to stop by TaskMan ***"
- +19 WRITE !,"*** Task #",$GET(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($HOROLOG)," ***"
- End DoDot:1
- QUIT
- +20 QUIT