LRCAPV ;DALOI/FHS - DETERMINE WKLD CODE AND STUFF INTO 68 ;2/19/91 11:45
;;5.2;LAB SERVICE;**232**;Sep 27, 1994
EN ;from LRVER4,LRVR4,LRMIEDZ,LRMIV,LROE,LRVER
K LRCSQ,LRCSQQ S LREND=0 Q:'$P(LRPARAM,U,14)!('$D(LRAA)) Q:'$P($G(^LRO(68,+LRAA,0)),U,16) S LRCSQQ=+$P(^(0),U,20)
I $D(LRCDEF),$D(LRCDEF0) W !!?7,"Currently you are using ( ",$P(LRCDEF0,U)_" ) Suffix ["_$P(LRCDEF0,U,2)_"]"
W !! K DIC S:$G(LRLL) DIC("B")=$S($G(^LRO(68.2,+LRLL,"SUF")):$P(^(0),U),1:"")
S LREND=0,DIC="^LRO(68.2,",DIC(0)="AQEM",DIC("A")="Work Load Area: ",DIC("S")="I $D(^(""SUF"")),+^(""SUF"")" D ^DIC S:Y<1 LREND=1 K DIC
EN1 Q:$G(LREND)
N LRSUFIEN,I
S LRSUF0=^LRO(68.2,+Y,"SUF") D
. S LRSUFIEN=$O(^LAB(64.2,"C",$P(LRSUF0,U,3)_" ",0))
. Q:'LRSUFIEN S $P(LRUSUFO,U)=LRSUFIEN
S LRCDEF0=$S($D(^LAB(64.2,+LRSUF0,0)):$P(^(0),U,1,18),1:0) S:LRCDEF0=0 LREND=1 G:$G(LREND) STOP S LRCDEF0(1)=$P(^(0),U,19),LRCDEF=$P($P(LRCDEF0,U,2),".",2)
S I=0 F S I=$O(^LRO(68.2,+Y,4,I)) Q:I<.5 S LRCDEF(I)=""
I '$P(LRSUF0,U,7) S $P(LRSUF0,U,7)=+LRAA,LRLD=$S($L($P($G(^LRO(68,LRAA,0)),U,19)):$P($G(^LRO(68,LRAA,0)),U,19),1:"CP"),LRCSQQ=+$P(^(0),U,20) K DIC
S:'$P(LRSUF0,U,8) $P(LRSUFO,U,8)=+LRAA
S LRCAPMS=$P(LRSUF0,U,7)_U_$S($P(LRSUF0,U,8):$P(LRSUF0,U,8),1:$P(LRSUF0,U,7)),LRCAPWA=$S($P(LRSUF0,U,9):$P(LRSUF0,U,9),1:$P(LRSUF0,U,8)),LRCAPMS=LRCAPMS_U_LRCAPWA
I $G(LRCSQQ) S LRCSQ=$H,^XTMP("LRCAP",LRCSQ,DUZ)=""
Q
AUTO ;from LRVR
Q:'$P(LRPARAM,U,14)!('$P($G(^LRO(68,+LRAA,0)),U,16)) S LRX=$G(^LRO(68,LRAA,0)),LRLD=$S($L($P(LRX,U,19)):$P(LRX,U,19),1:"CP") K LRX
I $D(^LRO(68.2,LRLL,"SUF")),+^("SUF") S LRCDEF0=^("SUF"),LRP=+LRCDEF0,LRCDEF0=$S($D(^LAB(64.2,LRP,0)):^(0),1:0) I LRCDEF0 S LRCDEF=$P(LRCDEF0,U,2),LRCDEF0(1)=$P(^(0),U,19)
G EN
Q
STD ;from LRVER,LRVER4,LRVR,LRVR4,LRVRW,LAMIAUTO,LRMIEDZ
I $G(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) K ^XTMP("LRCAP",LRCSQ) G STDQ
G:'$G(LRCSQ) STDQ
S LRCSQQ=+$P($G(^LRO(68,+$G(LRAA),0)),U,20) I 'LRCSQQ,$G(LRCSQ) K ^XTMP("LRCAP",LRCSQ) G STDQ
I '$P($G(LRPARAM),U,14) K:$G(LRCSQ) ^XTMP("LRCAP",LRCSQ) G STDQ
W !!?10,"Wish to enter STD/QC/REPS " S %=2 D YN^DICN G:%=0 STD I %'=1 G STDQ
S (LRREP,LRQC,LRSTD)=0
ST R !!?10,"Number of standards this run ",LRSTD:DTIME G:'$T!(LRSTD="^") SQR G:$G(LRSTD)="^QC" @("QC") G:$G(LRSTD)="^REP" @("REP") I $G(LRSTD)'=0,$G(LRSTD)'="",'+$G(LRSTD) D MSG G ST
QC R !!?10,"Number of QC this Run ",LRQC:DTIME G:'$T!($G(LRQC)="^") SQR G:$G(LRQC)="^STD" @("ST") G:$G(LRQC)="^REP" @("REP") I $G(LRQC)'=0,$G(LRQC)'="",'+$G(LRQC) D MSG G QC
REP R !!,?10,"Number of Repeats ",LRREP:DTIME G:'$T!($G(LRREP)="^") SQR G:$G(LRREP)="^QC" @("QC") G:$G(LRREP)="^STD" @("ST") I LRREP'=0,LRREP'="",'+LRREP D MSG G REP
SQR K LRTAGE,LRSUF0 I 'LRSTD&('LRQC)&('LRREP) G STDQ
S LRDUZ=DUZ,ZTSAVE("LRDUZ")="",ZTSAVE("LRSTD")="",ZTSAVE("LRQC")="",ZTSAVE("DT")="",ZTSAVE("LRREP")="",ZTSAVE("LRCSQ")="",ZTSAVE("U")="",^XTMP("LRCAP",LRCSQ,DUZ)=LRSTD_"STD^"_LRQC_"QC^"_LRREP_"REPS^"
S ZTRTN="QC^LRCAPPH",ZTIO="",ZTDTH=$H,ZTDESC="TALLY LAB QC/STD/REPS " D ^%ZTLOAD
SQR1 S ZTRTN="LRCAPV2",ZTDTH=$H,ZTDESC="LAB WORKLOAD PROGRAM",ZTIO="" D ^%ZTLOAD
K LRCSQ,LRCSQQ,LRSTD,LRQC,LRREP,LRDUZ
Q
STDQ K:$D(LRCSQ) ^XTMP("LRCAP",LRCSQ,DUZ) K LRCSQ,LRCSQQ
ANN I $P($G(LRPARAM),U,14) S ZTIO="",ZTRTN="LRCAPV2",ZTDTH=$H,ZTDESC="LAB WORKLOAD PROGRAM" D ^%ZTLOAD
K LRCSQ,LRCSQQ,LRSTD,LRQC,LRREP Q
CON ;
N J
S J=0 F S J=$O(^LAB(60,+X,2,J)) Q:J<1 I $D(^(J,0)) S NODE=+^(0) I '$D(LRTEST(NODE)) S LRTEST(NODE)="",LRNT(LRNT)=NODE S:'$O(^LAB(60,NODE,2,0)) LRNT=LRNT+1
Q
ENCON ;
N I
I '$O(^LAB(60,+X,2,0)) S LRNT=1 Q
K LRTEST,LRNT S LRNT=0 D CON S I=0 F S I=$O(LRNT(I)) Q:I="" S X=LRNT(I) D CON
Q
MSG W !!?10,"Enter a Number - Press Return or '^' to Stop " Q
STOP ;
S LREND=1 K LRCDEF,LRCDEF0,DIC,LRSUF0,LRCDEF,LRCDEF0X,LRLD,LRCAPMS,LRCAPWA,LRCSQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPV 3822 printed Sep 23, 2025@19:49:05 Page 2
LRCAPV ;DALOI/FHS - DETERMINE WKLD CODE AND STUFF INTO 68 ;2/19/91 11:45
+1 ;;5.2;LAB SERVICE;**232**;Sep 27, 1994
EN ;from LRVER4,LRVR4,LRMIEDZ,LRMIV,LROE,LRVER
+1 KILL LRCSQ,LRCSQQ
SET LREND=0
if '$PIECE(LRPARAM,U,14)!('$DATA(LRAA))
QUIT
if '$PIECE($GET(^LRO(68,+LRAA,0)),U,16)
QUIT
SET LRCSQQ=+$PIECE(^(0),U,20)
+2 IF $DATA(LRCDEF)
IF $DATA(LRCDEF0)
WRITE !!?7,"Currently you are using ( ",$PIECE(LRCDEF0,U)_" ) Suffix ["_$PIECE(LRCDEF0,U,2)_"]"
+3 WRITE !!
KILL DIC
if $GET(LRLL)
SET DIC("B")=$SELECT($GET(^LRO(68.2,+LRLL,"SUF")):$PIECE(^(0),U),1:"")
+4 SET LREND=0
SET DIC="^LRO(68.2,"
SET DIC(0)="AQEM"
SET DIC("A")="Work Load Area: "
SET DIC("S")="I $D(^(""SUF"")),+^(""SUF"")"
DO ^DIC
if Y<1
SET LREND=1
KILL DIC
EN1 if $GET(LREND)
QUIT
+1 NEW LRSUFIEN,I
+2 SET LRSUF0=^LRO(68.2,+Y,"SUF")
Begin DoDot:1
+3 SET LRSUFIEN=$ORDER(^LAB(64.2,"C",$PIECE(LRSUF0,U,3)_" ",0))
+4 if 'LRSUFIEN
QUIT
SET $PIECE(LRUSUFO,U)=LRSUFIEN
End DoDot:1
+5 SET LRCDEF0=$SELECT($DATA(^LAB(64.2,+LRSUF0,0)):$PIECE(^(0),U,1,18),1:0)
if LRCDEF0=0
SET LREND=1
if $GET(LREND)
GOTO STOP
SET LRCDEF0(1)=$PIECE(^(0),U,19)
SET LRCDEF=$PIECE($PIECE(LRCDEF0,U,2),".",2)
+6 SET I=0
FOR
SET I=$ORDER(^LRO(68.2,+Y,4,I))
if I<.5
QUIT
SET LRCDEF(I)=""
+7 IF '$PIECE(LRSUF0,U,7)
SET $PIECE(LRSUF0,U,7)=+LRAA
SET LRLD=$SELECT($LENGTH($PIECE($GET(^LRO(68,LRAA,0)),U,19)):$PIECE($GET(^LRO(68,LRAA,0)),U,19),1:"CP")
SET LRCSQQ=+$PIECE(^(0),U,20)
KILL DIC
+8 if '$PIECE(LRSUF0,U,8)
SET $PIECE(LRSUFO,U,8)=+LRAA
+9 SET LRCAPMS=$PIECE(LRSUF0,U,7)_U_$SELECT($PIECE(LRSUF0,U,8):$PIECE(LRSUF0,U,8),1:$PIECE(LRSUF0,U,7))
SET LRCAPWA=$SELECT($PIECE(LRSUF0,U,9):$PIECE(LRSUF0,U,9),1:$PIECE(LRSUF0,U,8))
SET LRCAPMS=LRCAPMS_U_LRCAPWA
+10 IF $GET(LRCSQQ)
SET LRCSQ=$HOROLOG
SET ^XTMP("LRCAP",LRCSQ,DUZ)=""
+11 QUIT
AUTO ;from LRVR
+1 if '$PIECE(LRPARAM,U,14)!('$PIECE($GET(^LRO(68,+LRAA,0)),U,16))
QUIT
SET LRX=$GET(^LRO(68,LRAA,0))
SET LRLD=$SELECT($LENGTH($PIECE(LRX,U,19)):$PIECE(LRX,U,19),1:"CP")
KILL LRX
+2 IF $DATA(^LRO(68.2,LRLL,"SUF"))
IF +^("SUF")
SET LRCDEF0=^("SUF")
SET LRP=+LRCDEF0
SET LRCDEF0=$SELECT($DATA(^LAB(64.2,LRP,0)):^(0),1:0)
IF LRCDEF0
SET LRCDEF=$PIECE(LRCDEF0,U,2)
SET LRCDEF0(1)=$PIECE(^(0),U,19)
+3 GOTO EN
+4 QUIT
STD ;from LRVER,LRVER4,LRVR,LRVR4,LRVRW,LAMIAUTO,LRMIEDZ
+1 IF $GET(LRCSQ)
IF '$ORDER(^XTMP("LRCAP",LRCSQ,DUZ,0))
KILL ^XTMP("LRCAP",LRCSQ)
GOTO STDQ
+2 if '$GET(LRCSQ)
GOTO STDQ
+3 SET LRCSQQ=+$PIECE($GET(^LRO(68,+$GET(LRAA),0)),U,20)
IF 'LRCSQQ
IF $GET(LRCSQ)
KILL ^XTMP("LRCAP",LRCSQ)
GOTO STDQ
+4 IF '$PIECE($GET(LRPARAM),U,14)
if $GET(LRCSQ)
KILL ^XTMP("LRCAP",LRCSQ)
GOTO STDQ
+5 WRITE !!?10,"Wish to enter STD/QC/REPS "
SET %=2
DO YN^DICN
if %=0
GOTO STD
IF %'=1
GOTO STDQ
+6 SET (LRREP,LRQC,LRSTD)=0
ST READ !!?10,"Number of standards this run ",LRSTD:DTIME
if '$TEST!(LRSTD="^")
GOTO SQR
if $GET(LRSTD)="^QC"
GOTO @("QC")
if $GET(LRSTD)="^REP"
GOTO @("REP")
IF $GET(LRSTD)'=0
IF $GET(LRSTD)'=""
IF '+$GET(LRSTD)
DO MSG
GOTO ST
QC READ !!?10,"Number of QC this Run ",LRQC:DTIME
if '$TEST!($GET(LRQC)="^")
GOTO SQR
if $GET(LRQC)="^STD"
GOTO @("ST")
if $GET(LRQC)="^REP"
GOTO @("REP")
IF $GET(LRQC)'=0
IF $GET(LRQC)'=""
IF '+$GET(LRQC)
DO MSG
GOTO QC
REP READ !!,?10,"Number of Repeats ",LRREP:DTIME
if '$TEST!($GET(LRREP)="^")
GOTO SQR
if $GET(LRREP)="^QC"
GOTO @("QC")
if $GET(LRREP)="^STD"
GOTO @("ST")
IF LRREP'=0
IF LRREP'=""
IF '+LRREP
DO MSG
GOTO REP
SQR KILL LRTAGE,LRSUF0
IF 'LRSTD&('LRQC)&('LRREP)
GOTO STDQ
+1 SET LRDUZ=DUZ
SET ZTSAVE("LRDUZ")=""
SET ZTSAVE("LRSTD")=""
SET ZTSAVE("LRQC")=""
SET ZTSAVE("DT")=""
SET ZTSAVE("LRREP")=""
SET ZTSAVE("LRCSQ")=""
SET ZTSAVE("U")=""
SET ^XTMP("LRCAP",LRCSQ,DUZ)=LRSTD_"STD^"_LRQC_"QC^"_LRREP_"REPS^"
+2 SET ZTRTN="QC^LRCAPPH"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="TALLY LAB QC/STD/REPS "
DO ^%ZTLOAD
SQR1 SET ZTRTN="LRCAPV2"
SET ZTDTH=$HOROLOG
SET ZTDESC="LAB WORKLOAD PROGRAM"
SET ZTIO=""
DO ^%ZTLOAD
+1 KILL LRCSQ,LRCSQQ,LRSTD,LRQC,LRREP,LRDUZ
+2 QUIT
STDQ if $DATA(LRCSQ)
KILL ^XTMP("LRCAP",LRCSQ,DUZ)
KILL LRCSQ,LRCSQQ
ANN IF $PIECE($GET(LRPARAM),U,14)
SET ZTIO=""
SET ZTRTN="LRCAPV2"
SET ZTDTH=$HOROLOG
SET ZTDESC="LAB WORKLOAD PROGRAM"
DO ^%ZTLOAD
+1 KILL LRCSQ,LRCSQQ,LRSTD,LRQC,LRREP
QUIT
CON ;
+1 NEW J
+2 SET J=0
FOR
SET J=$ORDER(^LAB(60,+X,2,J))
if J<1
QUIT
IF $DATA(^(J,0))
SET NODE=+^(0)
IF '$DATA(LRTEST(NODE))
SET LRTEST(NODE)=""
SET LRNT(LRNT)=NODE
if '$ORDER(^LAB(60,NODE,2,0))
SET LRNT=LRNT+1
+3 QUIT
ENCON ;
+1 NEW I
+2 IF '$ORDER(^LAB(60,+X,2,0))
SET LRNT=1
QUIT
+3 KILL LRTEST,LRNT
SET LRNT=0
DO CON
SET I=0
FOR
SET I=$ORDER(LRNT(I))
if I=""
QUIT
SET X=LRNT(I)
DO CON
+4 QUIT
MSG WRITE !!?10,"Enter a Number - Press Return or '^' to Stop "
QUIT
STOP ;
+1 SET LREND=1
KILL LRCDEF,LRCDEF0,DIC,LRSUF0,LRCDEF,LRCDEF0X,LRLD,LRCAPMS,LRCAPWA,LRCSQ
+2 QUIT
