LRLL3 ;SLC/RWF - LOAD LIST BUILD UTILITY ;2/5/91 14:34 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
PROF ;from LRLL, LRLL1
K ^TMP($J),LRCTRL,LRDSPEC,LRTP
S LRAA=$P(^LRO(68.2,LRINST,10,LRPROF,0),U,2)
S LRAD=$S($D(^LRO(68,LRAA,0)):$P(^(0),U,3),1:"") Q:LRAD="" S LRAD=$S(LRAD="Y":$E(DT,1,3)_"0000","D"[LRAD:DT,"M"[LRAD:$E(DT,1,5)_"00","Q"[LRAD:$E(DT,1,3)_"0000"+(($E(DT,4,5)-1)\3*300+100),1:DT)
S I=0 F S I=$O(^LRO(68.2,LRINST,10,LRPROF,1,I)) Q:I<1 S LRTP(+^(I,0))=$P(^(0),U,2)
S T=0 F S T=$O(^LRO(68.2,LRINST,10,LRPROF,2,T)) Q:T<1 S C=0 F S C=$O(^LRO(68.2,LRINST,10,LRPROF,2,T,1,C)) Q:C<1 S LRCT=^(C,0) D CTRLTST S LRCTRL(T,C)=X
F I=0:0 S I=$O(^LRO(68.2,LRINST,10,LRPROF,3,I)) Q:I<1 S LRDSPEC(+^(I,0))=""
Q
CTRLTST ;from LRLL1, LRLL2
S X=LRCT_U,J=0 F S J=$O(^LAB(62.3,LRCT,2,J)) Q:J<1 S Y=+^(J,0) S:$D(^LRO(68.2,LRINST,10,LRPROF,1,"B",+Y)) X=X_+Y_U
I '$P(X,U,2) W !,"CONTROL ",$P(^LAB(62.3,+X,0),U,1)," HAS NO TEST FOR THIS PROFILE."
Q
CLEAR ;from LRLL
W !,"WANT TO UNLOAD THE ",$S(LRTYPE:"LOAD",1:"WORK")," LIST FIRST" S %=2 D YN^DICN W:%=0 !,"If you're not sure, we'll skip it." W:%=-1 !,"Nothing cleared." S DUOUT=(%=-1) Q:%'=1
D CLEAR^LRLLS3 S (LAST,^LRO(68.2,LRINST,2))=DT_"^1^1^0^0"
I LRTYPE W !,"Do you want to delete all unverified ",$P(^LRO(68.2,LRINST,0),"^",1)," instrument data" S %=2 D YN^DICN S DUOUT=(%=-1) Q:%'=1 K ^LAH(LRINST)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLL3 1379 printed Nov 22, 2024@17:26:21 Page 2
LRLL3 ;SLC/RWF - LOAD LIST BUILD UTILITY ;2/5/91 14:34 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
PROF ;from LRLL, LRLL1
+1 KILL ^TMP($JOB),LRCTRL,LRDSPEC,LRTP
+2 SET LRAA=$PIECE(^LRO(68.2,LRINST,10,LRPROF,0),U,2)
+3 SET LRAD=$SELECT($DATA(^LRO(68,LRAA,0)):$PIECE(^(0),U,3),1:"")
if LRAD=""
QUIT
SET LRAD=$SELECT(LRAD="Y":$EXTRACT(DT,1,3)_"0000","D"[LRAD:DT,"M"[LRAD:$EXTRACT(DT,1,5)_"00","Q"[LRAD:$EXTRACT(DT,1,3)_"0000"+(($EXTRACT(DT,4,5)-1)\3*300+100),1:DT)
+4 SET I=0
FOR
SET I=$ORDER(^LRO(68.2,LRINST,10,LRPROF,1,I))
if I<1
QUIT
SET LRTP(+^(I,0))=$PIECE(^(0),U,2)
+5 SET T=0
FOR
SET T=$ORDER(^LRO(68.2,LRINST,10,LRPROF,2,T))
if T<1
QUIT
SET C=0
FOR
SET C=$ORDER(^LRO(68.2,LRINST,10,LRPROF,2,T,1,C))
if C<1
QUIT
SET LRCT=^(C,0)
DO CTRLTST
SET LRCTRL(T,C)=X
+6 FOR I=0:0
SET I=$ORDER(^LRO(68.2,LRINST,10,LRPROF,3,I))
if I<1
QUIT
SET LRDSPEC(+^(I,0))=""
+7 QUIT
CTRLTST ;from LRLL1, LRLL2
+1 SET X=LRCT_U
SET J=0
FOR
SET J=$ORDER(^LAB(62.3,LRCT,2,J))
if J<1
QUIT
SET Y=+^(J,0)
if $DATA(^LRO(68.2,LRINST,10,LRPROF,1,"B",+Y))
SET X=X_+Y_U
+2 IF '$PIECE(X,U,2)
WRITE !,"CONTROL ",$PIECE(^LAB(62.3,+X,0),U,1)," HAS NO TEST FOR THIS PROFILE."
+3 QUIT
CLEAR ;from LRLL
+1 WRITE !,"WANT TO UNLOAD THE ",$SELECT(LRTYPE:"LOAD",1:"WORK")," LIST FIRST"
SET %=2
DO YN^DICN
if %=0
WRITE !,"If you're not sure, we'll skip it."
if %=-1
WRITE !,"Nothing cleared."
SET DUOUT=(%=-1)
if %'=1
QUIT
+2 DO CLEAR^LRLLS3
SET (LAST,^LRO(68.2,LRINST,2))=DT_"^1^1^0^0"
+3 IF LRTYPE
WRITE !,"Do you want to delete all unverified ",$PIECE(^LRO(68.2,LRINST,0),"^",1)," instrument data"
SET %=2
DO YN^DICN
SET DUOUT=(%=-1)
if %'=1
QUIT
KILL ^LAH(LRINST)
+4 QUIT
