source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSTUF1.m@ 842

Last change on this file since 842 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1LRSTUF1 ;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)
9DAT D ADATE^LRWU Q:Y<1
10TEST 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 ;
23L1 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
24L2 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
26L3 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."
31LOOP 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
42LREND Q
Note: See TracBrowser for help on using the repository browser.