Routine: LRLL3

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))=""

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."

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLL3   1379     printed  Apr 09, 2024@21:22:23                                                                                                                                                                                                       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

LRLL3.m