Routine: LRSETUP

LRSETUP ; IHS/DIR/FJE - REINITIALIZE DATA FILES 2/6/91 14:34 ;

 ;;5.2;LR;;NOV 01, 1997

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 W !!,">> I WILL DO SOME FILE CHECKING AND THIS MAY TAKE A LITTLE WHILE <<",!!

 I $D(^LAB(62.4,1,0))[0 D

 . F  L +^LAB(62.4):1 Q:$T  W !!?7,"Someone else is editing the Automated Instrument file ",!!,$C(7) H 30

 . S ^(0)="^LABDATA",DIE="^LAB(62.4,",DR=".01///LSI#1;2///LAB",DA=1 D ^DIE W !,"I have added a LSI controller #1 to the auto instrument file",!,"Please check this entry after the init is finished",!,$C(7)

 . L -^LAB(62.4)

 F I=0:0 S I=$O(^LRO(68.2,I)) Q:I'>0  F J=0:0 S J=$O(^LRO(68.2,I,10,J)) Q:J'>0  F K=0:0 S K=$O(^LRO(68.2,I,10,J,1,K)) Q:K'>0  I $S($D(^(K,0)):$E($P(^(0),"^",3),1),1:0)="Y" S $P(^(0),"^",3)=1

 S $P(^LAB(64.5,1,1,0),"^")="MAJOR HEADER"

FRESH I '$D(^XUSEC("LRLIASON",DUZ)) W !,"Not cleared for this option." Q

POST W !!,"This procedure will purge/kill all entries in the ^LR( global"

 W !,"and the ^LRO( global. This should not be ran by any site already"

 W !,"running the Laboratory Package. It should only be used by First"

 W !,"Time Installation Sites. If your are not a First Time installation"

 W !,"DO NOT RUN this routine. If you have questions, contact your "

 W !,"Information Systems Center (ISC) before continuing"

 W !!?10,"Do you Wish to continue "

 S %=2 D YN^DICN G:%=0 POST Q:%'=1

 W !!?10,"ARE YOU CERTAIN - LAST CHANCE " S %=2 D YN^DICN G:%=0 POST Q:%'=1

 W !!,"In order to continue, you must answer the next prompt by"

 W !,"entering 'YES' --  A simple 'Y' will not work",!

 W !!,"IF YOU ARE READY   ANSWER 'YES'  " R ANS:100 Q:'$T  Q:ANS'="YES"

 W !!?5,"This will take a while ",!

 K ^LR("AAU"),^("AAUA"),^("ACY"),^("ACYA"),^("AEM"),^("AEMA"),^("ASP"),^("ASPA"),^("B"),^("AD") S ^LR(0)=$P(^LR(0),"^",1,2) S I=0 F  S I=$O(^LR(I)) Q:I<1  K ^LR(I)

 I $D(^LRD(65,0)) S X=$P(^LRD(65,0),"^",1,2),^LRD(65,0)=X,I=0 F A=0:0 S I=$O(^LRD(65,I)) Q:I=""  K ^(I)

 I $D(^LRE(0)) K ^LRE("AD"),^LRE("AT"),^LRE("B"),^("C"),^("D"),^("G"),^("G4") S ^LRE(0)=$P(^LRE(0),"^",1,2) S I=0 F  S I=$O(^LRE(I)) Q:I<1  K ^LRE(I)

 S I=0 F  S I=$O(^DPT(I)) Q:I<1  I $D(^DPT(I,"LR")) K ^DPT(I,"LR")

 F I=0:0 S I=$O(^LAB(62.3,I)) Q:I<1  S X=$P(^(I,0),U) I '$D(^LAB(62.3,"B",X)) K ^LAB(62.3,I)

 S LRDPF="62.3^LAB(62.3," S I=0 F  S I=$O(^LAB(62.3,I)) Q:I<1  K ^LAB(62.3,I,"LR") S DFN=I D END^LRDPA

 F F=67,67.1,67.2,67.3 S I=0 F  S I=$O(^LRT(F,I)) Q:I<1  K ^LRT(F,I,"LR")

 S X=$P(^LRO(67.9,0),U,1,2) K ^LRO(67.9) S ^LRO(67.9,0)=X

 S I=0 F  S I=$O(^LRO(68,I)) Q:I<1  K ^LRO(68,I,1)

 S I=0 F  S I=$O(^LRO(69.2,I)) Q:I<1  S J=0 F  S J=$O(^LRO(69.2,I,J)) Q:J<1  K ^LRO(69.2,I,J)

 S ^LAC(0)="" F I=0:0 S I=$O(^LAC(I)) Q:I=""  K ^(I)

 K ^LRO(68,"AA"),^("AC"),^("MI"),^("AVS"),^LAC("LRAC"),^("LRPHSET"),^("LGOT"),^("DEV") S ^LAC("LRAC",0)="CUMULATIVE^64.7",X=$P(^LRO(69,0),"^",1,2) K ^LRO(69) S ^LRO(69,0)=X

 F I=0:0 S I=$O(^LRO(68.2,I)) Q:I<1  K ^(I,1)

 S X=$P(^LRO(69.1,0),U,1,2) K ^LRO(69.1) S ^LRO(69.1,0)=X

 S X=$P(^LRO(69.2,0),U,1,2) K ^LRO(69.2) S ^LRO(69.2,0)=X

 S X=$P(^LRO(64.1,0),U,1,2) K ^LRO(64.1) S ^LRO(64.1,0)=X

 S X=$P(^BLRTXLOG(0),U,1,2) K ^BLRTXLOG S ^BLRTXLOG(0)=X

 S X=$P(^BLRSITE(0),U,1,2) K ^BLRSITE S ^BLRSITE(0)=X

 W !!?10,"Your files have been purged to day 1 status",!!

LRSETUP   ; IHS/DIR/FJE - REINITIALIZE DATA FILES 2/6/91 14:34 ;

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        WRITE !!,">> I WILL DO SOME FILE CHECKING AND THIS MAY TAKE A LITTLE WHILE <<",!!

 +5        IF $DATA(^LAB(62.4,1,0))[0

               Begin DoDot:1

 +6                FOR

                       LOCK +^LAB(62.4):1

                       IF $TEST

                           QUIT

                       WRITE !!?7,"Someone else is editing the Automated Instrument file ",!!,$CHAR(7)

                       HANG 30

 +7                SET ^(0)="^LABDATA"

                   SET DIE="^LAB(62.4,"

                   SET DR=".01///LSI#1;2///LAB"

                   SET DA=1

                   DO ^DIE

                   WRITE !,"I have added a LSI controller #1 to the auto instrument file",!,"Please check this entry after the init is finished",!,$CHAR(7)

 +8                LOCK -^LAB(62.4)

               End DoDot:1

 +9        FOR I=0:0

               SET I=$ORDER(^LRO(68.2,I))

               IF I'>0

                   QUIT

               FOR J=0:0

                   SET J=$ORDER(^LRO(68.2,I,10,J))

                   IF J'>0

                       QUIT

                   FOR K=0:0

                       SET K=$ORDER(^LRO(68.2,I,10,J,1,K))

                       IF K'>0

                           QUIT

                       IF $SELECT($DATA(^(K,0)):$EXTRACT($PIECE(^(0),"^",3),1),1:0)="Y"

                           SET $PIECE(^(0),"^",3)=1

 +10       SET $PIECE(^LAB(64.5,1,1,0),"^")="MAJOR HEADER"

 +11       QUIT

FRESH      IF '$DATA(^XUSEC("LRLIASON",DUZ))

               WRITE !,"Not cleared for this option."

               QUIT

POST       WRITE !!,"This procedure will purge/kill all entries in the ^LR( global"

 +1        WRITE !,"and the ^LRO( global. This should not be ran by any site already"

 +2        WRITE !,"running the Laboratory Package. It should only be used by First"

 +3        WRITE !,"Time Installation Sites. If your are not a First Time installation"

 +4        WRITE !,"DO NOT RUN this routine. If you have questions, contact your "

 +5        WRITE !,"Information Systems Center (ISC) before continuing"

 +6        WRITE !!?10,"Do you Wish to continue "

 +7        SET %=2

           DO YN^DICN

           IF %=0

               GOTO POST

           IF %'=1

               QUIT

 +8        WRITE !!?10,"ARE YOU CERTAIN - LAST CHANCE "

           SET %=2

           DO YN^DICN

           IF %=0

               GOTO POST

           IF %'=1

               QUIT

 +9        WRITE !!,"In order to continue, you must answer the next prompt by"

 +10       WRITE !,"entering 'YES' --  A simple 'Y' will not work",!

 +11       WRITE !!,"IF YOU ARE READY   ANSWER 'YES'  "

           READ ANS:100

           IF '$TEST

               QUIT

           IF ANS'="YES"

               QUIT

 +12       WRITE !!?5,"This will take a while ",!

 +13       KILL ^LR("AAU"),^("AAUA"),^("ACY"),^("ACYA"),^("AEM"),^("AEMA"),^("ASP"),^("ASPA"),^("B"),^("AD")

           SET ^LR(0)=$PIECE(^LR(0),"^",1,2)

           SET I=0

FOR

               SET I=$ORDER(^LR(I))

               IF I<1

                   QUIT

               KILL ^LR(I)

 +14       IF $DATA(^LRD(65,0))

               SET X=$PIECE(^LRD(65,0),"^",1,2)

               SET ^LRD(65,0)=X

               SET I=0

               FOR A=0:0

                   SET I=$ORDER(^LRD(65,I))

                   IF I=""

                       QUIT

                   KILL ^(I)

 +15       IF $DATA(^LRE(0))

               KILL ^LRE("AD"),^LRE("AT"),^LRE("B"),^("C"),^("D"),^("G"),^("G4")

               SET ^LRE(0)=$PIECE(^LRE(0),"^",1,2)

               SET I=0

FOR

                   SET I=$ORDER(^LRE(I))

                   IF I<1

                       QUIT

                   KILL ^LRE(I)

 +16       SET I=0

FOR

               SET I=$ORDER(^DPT(I))

               IF I<1

                   QUIT

               IF $DATA(^DPT(I,"LR"))

                   KILL ^DPT(I,"LR")

 +17       FOR I=0:0

               SET I=$ORDER(^LAB(62.3,I))

               IF I<1

                   QUIT

               SET X=$PIECE(^(I,0),U)

               IF '$DATA(^LAB(62.3,"B",X))

                   KILL ^LAB(62.3,I)

 +18       SET LRDPF="62.3^LAB(62.3,"

           SET I=0

FOR

               SET I=$ORDER(^LAB(62.3,I))

               IF I<1

                   QUIT

               KILL ^LAB(62.3,I,"LR")

               SET DFN=I

               DO END^LRDPA

 +19       FOR F=67,67.1,67.2,67.3

               SET I=0

FOR

                   SET I=$ORDER(^LRT(F,I))

                   IF I<1

                       QUIT

                   KILL ^LRT(F,I,"LR")

 +20       SET X=$PIECE(^LRO(67.9,0),U,1,2)

           KILL ^LRO(67.9)

           SET ^LRO(67.9,0)=X

 +21       SET I=0

FOR

               SET I=$ORDER(^LRO(68,I))

               IF I<1

                   QUIT

               KILL ^LRO(68,I,1)

 +22       SET I=0

FOR

               SET I=$ORDER(^LRO(69.2,I))

               IF I<1

                   QUIT

               SET J=0

FOR

                   SET J=$ORDER(^LRO(69.2,I,J))

                   IF J<1

                       QUIT

                   KILL ^LRO(69.2,I,J)

 +23       SET ^LAC(0)=""

           FOR I=0:0

               SET I=$ORDER(^LAC(I))

               IF I=""

                   QUIT

               KILL ^(I)

 +24       KILL ^LRO(68,"AA"),^("AC"),^("MI"),^("AVS"),^LAC("LRAC"),^("LRPHSET"),^("LGOT"),^("DEV")

           SET ^LAC("LRAC",0)="CUMULATIVE^64.7"

           SET X=$PIECE(^LRO(69,0),"^",1,2)

           KILL ^LRO(69)

           SET ^LRO(69,0)=X

 +25       FOR I=0:0

               SET I=$ORDER(^LRO(68.2,I))

               IF I<1

                   QUIT

               KILL ^(I,1)

 +26       SET X=$PIECE(^LRO(69.1,0),U,1,2)

           KILL ^LRO(69.1)

           SET ^LRO(69.1,0)=X

 +27       SET X=$PIECE(^LRO(69.2,0),U,1,2)

           KILL ^LRO(69.2)

           SET ^LRO(69.2,0)=X

 +28       SET X=$PIECE(^LRO(64.1,0),U,1,2)

           KILL ^LRO(64.1)

           SET ^LRO(64.1,0)=X

 +29       SET X=$PIECE(^BLRTXLOG(0),U,1,2)

           KILL ^BLRTXLOG

           SET ^BLRTXLOG(0)=X

 +30       SET X=$PIECE(^BLRSITE(0),U,1,2)

           KILL ^BLRSITE

           SET ^BLRSITE(0)=X

 +31       WRITE !!?10,"Your files have been purged to day 1 status",!!

 +32       QUIT

LRSETUP.m