LRSTUF1 ;DALOI/CJS - MASS DATA ENTRY INTO FILE 63.04 ;5/13/03 1300
;;5.2;LAB SERVICE;**153,286**;Sep 27, 1994
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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSTUF1 2975 printed Oct 16, 2024@18:21:45 Page 2
LRSTUF1 ;DALOI/CJS - MASS DATA ENTRY INTO FILE 63.04 ;5/13/03 1300
+1 ;;5.2;LAB SERVICE;**153,286**;Sep 27, 1994
+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 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,SSN
+4 KILL ^TMP("LR",$JOB,"T"),A,LRTSTS,LRORD
+5 SET X=DUZ
DO DUZ^LRX
+6 READ !,"If everything is OK, enter your initials: ",LRINI:DTIME
IF LRINI'=LRUSI!'$LENGTH(LRUSI)
WRITE !,"NOT APPROVED"
GOTO LREND
+7 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
+8 SET %DT="T"
SET X="N"
SET LRTEC=LRUSI
DO ^%DT
SET LRNOW=+Y
SET LREND=0
SET LRAN=0
+9 FOR
SET LRAN=$ORDER(LRAC(LRAN))
if LRAN<1
QUIT
DO LRSTUFF^LRSTUF2
if LREND
QUIT
+10 GOTO LREND
LREND QUIT
