| [613] | 1 | LRSTUF1 ;DALOI/CJS - MASS DATA ENTRY INTO FILE 63.04 ;5/13/03 1300 | 
|---|
|  | 2 | ;;5.2;LAB SERVICE;**153,286**;Sep 27, 1994 | 
|---|
|  | 3 | K ^TMP("LR",$J,"VTO"),M,LRSB,^TMP("LR",$J,"TMP") | 
|---|
|  | 4 | S DIC=68,DIC(0)="AEZMOQ" D ^DIC Q:Y<1  S LRAA=+Y | 
|---|
|  | 5 | S X=$$SELPL^LRVERA(DUZ(2)) | 
|---|
|  | 6 | I X<1 Q | 
|---|
|  | 7 | I X'=DUZ(2) N LRDUZ S LRDUZ(2)=X | 
|---|
|  | 8 | I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV Q:$G(LREND) | 
|---|
|  | 9 | DAT D ADATE^LRWU Q:Y<1 | 
|---|
|  | 10 | TEST S DIC="^LAB(60,",DIC("A")="Select ORDERED TEST: ",DIC(0)="AEZOQ" | 
|---|
|  | 11 | D ^DIC Q:Y<1 | 
|---|
|  | 12 | S LRTEST=+Y,^TMP("LR",$J,"VTO",+Y)=$P($P(Y(0),U,5),";",2) | 
|---|
|  | 13 | ; | 
|---|
|  | 14 | K ^TMP("LR",$J,"T"),LRORD,LRTSTS | 
|---|
|  | 15 | D ^LREXPD | 
|---|
|  | 16 | K A | 
|---|
|  | 17 | 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 | 
|---|
|  | 18 | S LRTESTSV=LRTEST,LRFFLG="" I A1=1 S LRFLD=+$O(A(0)) G L2 | 
|---|
|  | 19 | I A1<1 W !,"No way to put data in for that test." Q | 
|---|
|  | 20 | S I=0 | 
|---|
|  | 21 | F  S I=$O(A(I)) Q:I<1  W !,I,?5," ",$P(^DD(63.04,I,0),"^") | 
|---|
|  | 22 | ; | 
|---|
|  | 23 | 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 | 
|---|
|  | 24 | L2 W !,"1  Automatically enter your entry.",!,"2  Prompt with your entry.",!,"3  Just Prompt." | 
|---|
|  | 25 | 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 | 
|---|
|  | 26 | 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 | 
|---|
|  | 27 | 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 | 
|---|
|  | 28 | 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 | 
|---|
|  | 29 | K LRAC W !,"Enter the accessions you wish to edit." | 
|---|
|  | 30 | 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." | 
|---|
|  | 31 | 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 | 
|---|
|  | 32 | 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)="" | 
|---|
|  | 33 | G LOOP:'(X=""!(X="^")) | 
|---|
|  | 34 | 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 | 
|---|
|  | 35 | K ^TMP("LR",$J,"T"),A,LRTSTS,LRORD | 
|---|
|  | 36 | S X=DUZ D DUZ^LRX | 
|---|
|  | 37 | R !,"If everything is OK, enter your initials: ",LRINI:DTIME I LRINI'=LRUSI!'$L(LRUSI) W !,"NOT APPROVED" G LREND | 
|---|
|  | 38 | 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 | 
|---|
|  | 39 | S %DT="T",X="N",LRTEC=LRUSI D ^%DT S LRNOW=+Y,LREND=0,LRAN=0 | 
|---|
|  | 40 | F  S LRAN=$O(LRAC(LRAN)) Q:LRAN<1  D LRSTUFF^LRSTUF2 Q:LREND | 
|---|
|  | 41 | G LREND | 
|---|
|  | 42 | LREND Q | 
|---|