LRSTUF1.m

LRSTUF1 ;VA/DALOI/CJS - MASS DATA ENTRY INTO FILE 63.04 ;JUL 06, 2010 3:14 PM

 ;;5.2;LAB SERVICE;**153,286,1027**;NOV 01, 1997

 K ^TMP("LR",$J,"VTO"),M,LRSB,^TMP("LR",$J,"TMP")

 S DIC=68,DIC(0)="AEZMOQ" D ^DIC Q:Y<1  S LRAA=+Y

 S X=$$SELPL^LRVERA(DUZ(2))

 I X<1 Q

 I X'=DUZ(2) N LRDUZ S LRDUZ(2)=X

 I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV Q:$G(LREND)

DAT D ADATE^LRWU Q:Y<1

TEST S DIC="^LAB(60,",DIC("A")="Select ORDERED TEST: ",DIC(0)="AEZOQ"

 D ^DIC Q:Y<1

 S LRTEST=+Y,^TMP("LR",$J,"VTO",+Y)=$P($P(Y(0),U,5),";",2)

 ;

 K ^TMP("LR",$J,"T"),LRORD,LRTSTS

 D ^LREXPD

 K A

 S (A1,I)=0 F  S I=$O(^TMP("LR",$J,"T",I)) Q:I<1  S X=^(I),A(+$P($P(X,"^",12),",",2))=I,A1=A1+1 S:$P(X,U,17) M($P($P(X,U,5),";",2))=I

 S LRTESTSV=LRTEST,LRFFLG="" I A1=1 S LRFLD=+$O(A(0)) G L2

 I A1<1 W !,"No way to put data in for that test." Q

 S I=0

 F  S I=$O(A(I)) Q:I<1  W !,I,?5," ",$P(^DD(63.04,I,0),"^")

 ;

L1 S DIC("A")="Enter the field to edit: ",DIC(0)="AE",DIC("S")="I $D(A(+Y))",DIC="^DD(63.04," D ^DIC K DIC G LREND:Y=-1 S LRFLD=+Y

L2 W !,"1  Automatically enter your entry.",!,"2  Prompt with your entry.",!,"3  Just Prompt."

 R !,"Choice: ",X:DTIME Q:X=""!(X["^")  I +X'=X!(X>3)!(X<1)!(X?.E1"."1N.N) W !,"Enter a number between 1 and 3." G L2

L3 S LRA=X K LRSTUFF,DIC I X<3 W !,"What do you want entered?: " R LRSTUFF:DTIME I LRSTUFF="?" W !,"    What you enter will go through the input transform to be stored in the",!,"    field you have specified." G L3

 W !,"I will ",$S(X=1:"automatically stuff ",1:"prompt "),$P(^DD(63.04,LRFLD,0),U) W:$D(LRSTUFF) !,"with ",LRSTUFF W !,"   ...OK" S %=1 D YN^DICN G TEST:%=-1,L3:%'=1

 S DR=LRFLD_$S(X=1:"///"_LRSTUFF,X=2:"//"_LRSTUFF,1:"")_";S LRVX=X;.03///N;S LRNOW=X;.04////"_DUZ,^TMP("LR",$J,"VTO",A(LRFLD))=LRFLD

 K LRAC W !,"Enter the accessions you wish to edit."

 W !,"Enter a string of numbers separated with , . ^ or space,",!,"or a range of numbers, e.g. 50-75.  You may enter more than one line."

LOOP R !,"Enter your selection(s) > ",X:DTIME I X="?" W !,"Enter a string of numbers separated with , . ^ or space,",!,"or a range of numbers, e.g. 50-75.  You may enter more than one line." G LOOP

 S D=$S(X[",":",",X[".":".",X["^":"^",1:" ") F I=1:1 S LRAC=$P(X,D,I) D:LRAC["-" RANGE^LRSTUF2 Q:LRAC=""  S LRAC(+LRAC)=""

 G LOOP:'(X=""!(X="^"))

 ; I $O(LRAC(0))>0 W !,"Editing the following:" S LRAC=0 F  S LRAC=$O(LRAC(LRAC)) Q:LRAC<1  I $D(^LRO(68,LRAA,1,LRAD,1,LRAC,0)) S LRDFN=+^(0),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,"Acc #: ",LRAC,?15,PNM,?45,SSN

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 I $O(LRAC(0))>0 W !,"Editing the following:" S LRAC=0 F  S LRAC=$O(LRAC(LRAC)) Q:LRAC<1  I $D(^LRO(68,LRAA,1,LRAD,1,LRAC,0)) S LRDFN=+^(0),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,"Acc #: ",LRAC,?15,PNM,?45,HRCN  ;IHS/ANMC/CLS

 ;----- EN DIHS MODIFICATIONS

 K ^TMP("LR",$J,"T"),A,LRTSTS,LRORD

 S X=DUZ D DUZ^LRX

 R !,"If everything is OK, enter your initials: ",LRINI:DTIME I LRINI'=LRUSI!'$L(LRUSI) W !,"NOT APPROVED" G LREND

 S LRTN=1,LRSS="CH",LROUTINE=$P(^LAB(69.9,1,3),U,2) S I=0 F  S I=$O(M(I)) Q:I<1  S ^TMP("LR",$J,"TMP",LRSS,I)=1

 S %DT="T",X="N",LRTEC=LRUSI D ^%DT S LRNOW=+Y,LREND=0,LRAN=0

 F  S LRAN=$O(LRAC(LRAN)) Q:LRAN<1  D LRSTUFF^LRSTUF2 Q:LREND

 G LREND

LREND Q

LRSTUF1   ;VA/DALOI/CJS - MASS DATA ENTRY INTO FILE 63.04 ;JUL 06, 2010 3:14 PM

 +1       ;;5.2;LAB SERVICE;**153,286,1027**;NOV 01, 1997

 +2        KILL ^TMP("LR",$JOB,"VTO"),M,LRSB,^TMP("LR",$JOB,"TMP")

 +3        SET DIC=68

           SET DIC(0)="AEZMOQ"

           DO ^DIC

           IF Y<1

               QUIT 

           SET LRAA=+Y

 +4        SET X=$$SELPL^LRVERA(DUZ(2))

 +5        IF X<1

               QUIT 

 +6        IF X'=DUZ(2)

               NEW LRDUZ

               SET LRDUZ(2)=X

 +7        IF $PIECE(LRPARAM,U,14)

               IF $PIECE($GET(^LRO(68,LRAA,0)),U,16)

                   DO ^LRCAPV

                   IF $GET(LREND)

                       QUIT 

DAT        DO ADATE^LRWU

           IF Y<1

               QUIT 

TEST       SET DIC="^LAB(60,"

           SET DIC("A")="Select ORDERED TEST: "

           SET DIC(0)="AEZOQ"

 +1        DO ^DIC

           IF Y<1

               QUIT 

 +2        SET LRTEST=+Y

           SET ^TMP("LR",$JOB,"VTO",+Y)=$PIECE($PIECE(Y(0),U,5),";",2)

 +3       ;

 +4        KILL ^TMP("LR",$JOB,"T"),LRORD,LRTSTS

 +5        DO ^LREXPD

 +6        KILL A

 +7        SET (A1,I)=0

           FOR 

               SET I=$ORDER(^TMP("LR",$JOB,"T",I))

               IF I<1

                   QUIT 

               SET X=^(I)

               SET A(+$PIECE($PIECE(X,"^",12),",",2))=I

               SET A1=A1+1

               IF $PIECE(X,U,17)

                   SET M($PIECE($PIECE(X,U,5),";",2))=I

 +8        SET LRTESTSV=LRTEST

           SET LRFFLG=""

           IF A1=1

               SET LRFLD=+$ORDER(A(0))

               GOTO L2

 +9        IF A1<1

               WRITE !,"No way to put data in for that test."

               QUIT 

 +10       SET I=0

 +11       FOR 

               SET I=$ORDER(A(I))

               IF I<1

                   QUIT 

               WRITE !,I,?5," ",$PIECE(^DD(63.04,I,0),"^")

 +12      ;

L1         SET DIC("A")="Enter the field to edit: "

           SET DIC(0)="AE"

           SET DIC("S")="I $D(A(+Y))"

           SET DIC="^DD(63.04,"

           DO ^DIC

           KILL DIC

           IF Y=-1

               GOTO LREND

           SET LRFLD=+Y

L2         WRITE !,"1  Automatically enter your entry.",!,"2  Prompt with your entry.",!,"3  Just Prompt."

 +1        READ !,"Choice: ",X:DTIME

           IF X=""!(X["^")

               QUIT 

           IF +X'=X!(X>3)!(X<1)!(X?.E1"."1N.N)

               WRITE !,"Enter a number between 1 and 3."

               GOTO L2

L3         SET LRA=X

           KILL LRSTUFF,DIC

           IF X<3

               WRITE !,"What do you want entered?: "

               READ LRSTUFF:DTIME

               IF LRSTUFF="?"

                   WRITE !,"    What you enter will go through the input transform to be stored in the",!,"    field you have specified."

                   GOTO L3

 +1        WRITE !,"I will ",$SELECT(X=1:"automatically stuff ",1:"prompt "),$PIECE(^DD(63.04,LRFLD,0),U)

           IF $DATA(LRSTUFF)

               WRITE !,"with ",LRSTUFF

           WRITE !,"   ...OK"

           SET %=1

           DO YN^DICN

           IF %=-1

               GOTO TEST

           IF %'=1

               GOTO L3

 +2        SET DR=LRFLD_$SELECT(X=1:"///"_LRSTUFF,X=2:"//"_LRSTUFF,1:"")_";S LRVX=X;.03///N;S LRNOW=X;.04////"_DUZ

           SET ^TMP("LR",$JOB,"VTO",A(LRFLD))=LRFLD

 +3        KILL LRAC

           WRITE !,"Enter the accessions you wish to edit."

 +4        WRITE !,"Enter a string of numbers separated with , . ^ or space,",!,"or a range of numbers, e.g. 50-75.  You may enter more than one line."

LOOP       READ !,"Enter your selection(s) > ",X:DTIME

           IF X="?"

               WRITE !,"Enter a string of numbers separated with , . ^ or space,",!,"or a range of numbers, e.g. 50-75.  You may enter more than one line."

               GOTO LOOP

 +1        SET D=$SELECT(X[",":",",X[".":".",X["^":"^",1:" ")

           FOR I=1:1

               SET LRAC=$PIECE(X,D,I)

               IF LRAC["-"

                   DO RANGE^LRSTUF2

               IF LRAC=""

                   QUIT 

               SET LRAC(+LRAC)=""

 +2        IF '(X=""!(X="^"))

               GOTO LOOP

 +3       ; I $O(LRAC(0))>0 W !,"Editing the following:" S LRAC=0 F  S LRAC=$O(LRAC(LRAC)) Q:LRAC<1  I $D(^LRO(68,LRAA,1,LRAD,1,LRAC,0)) S LRDFN=+^(0),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,"Acc #: ",LRAC,?15,PNM,?45,SSN

 +4       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +5       ;IHS/ANMC/CLS

           IF $ORDER(LRAC(0))>0

               WRITE !,"Editing the following:"

               SET LRAC=0

               FOR 

                   SET LRAC=$ORDER(LRAC(LRAC))

                   IF LRAC<1

                       QUIT 

                   IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAC,0))

                       SET LRDFN=+^(0)

                       SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)

                       SET DFN=$PIECE(^(0),U,3)

                       DO PT^LRX

                       WRITE !,"Acc #: ",LRAC,?15,PNM,?45,HRCN

 +6       ;----- EN DIHS MODIFICATIONS

 +7        KILL ^TMP("LR",$JOB,"T"),A,LRTSTS,LRORD

 +8        SET X=DUZ

           DO DUZ^LRX

 +9        READ !,"If everything is OK, enter your initials: ",LRINI:DTIME

           IF LRINI'=LRUSI!'$LENGTH(LRUSI)

               WRITE !,"NOT APPROVED"

               GOTO LREND

 +10       SET LRTN=1

           SET LRSS="CH"

           SET LROUTINE=$PIECE(^LAB(69.9,1,3),U,2)

           SET I=0

           FOR 

               SET I=$ORDER(M(I))

               IF I<1

                   QUIT 

               SET ^TMP("LR",$JOB,"TMP",LRSS,I)=1

 +11       SET %DT="T"

           SET X="N"

           SET LRTEC=LRUSI

           DO ^%DT

           SET LRNOW=+Y

           SET LREND=0

           SET LRAN=0

 +12       FOR 

               SET LRAN=$ORDER(LRAC(LRAN))

               IF LRAN<1

                   QUIT 

               DO LRSTUFF^LRSTUF2

               IF LREND

                   QUIT 

 +13       GOTO LREND

LREND      QUIT