[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
|
---|