LRSTUF2 ;DALOI/STAFF - MASS DATA ENTRY INTO FILE 63.04 ;07/12/12 17:03
;;5.2;LAB SERVICE;**121,153,263,347,350,461**;Sep 27, 1994;Build 15
;
LRSTUFF ;
N LRCDT
W !,"Acc #: ",LRAN
;
I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))!'$D(^(3)) W !," not set up." Q
;
;Check for test on accession
;Also, prevent stuffing of merged or cancelled accessions
;
N LRMTST,LRTCHK,LRMSTR,LRNOP
S (LRMTST,LRNOP)=0,LRTCHK=""
F S LRMTST=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRMTST)) Q:'LRMTST D
. ;adding a $G because there is one for this global reference in other routines
. S LRMSTR=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRMTST,0))
. I LRTESTSV'=+LRMSTR Q
. S LRNOP=1
. I $P(LRMSTR,U,6)="*Not Performed" S LRTCHK="previously cancelled"
. I $P(LRMSTR,U,6)="*Merged" S LRTCHK="merged to another accession"
I 'LRNOP W " doesn't have the selected test." Q
I LRTCHK]"" W " not stuffed because ",LRTCHK Q
;
S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRODT=$P(^(0),U,4),LRSN=$P(^(0),U,5)
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
W ?15,PNM,?45,SSN
Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
;
S LRCDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U),LRIDT=$P(^(3),U,5),LRMETH="(BD)"_DUZ_"/"_DUZ(2)
I LRDPF'=62.3 S LRLLOC=$P(^(0),U,7) S:LRLLOC="" LRLLOC="UNKNOWN" W ?65,LRLLOC
;
L +^LR(LRDFN,"CH",LRIDT):DILOCKTM
I '$T W !!,"Someone else is editing this entry ",!,$C(7) Q
;
I $P(^LR(LRDFN,LRSS,LRIDT,0),U,3),("pending"'[$S($D(^(LRFLD)):$P(^(LRFLD),U,1),1:"pending")) W !?25,"VERIFIED DATA, CAN'T CHANGE" L -^LR(LRDFN,"CH",LRIDT) Q
I $P(^LR(LRDFN,LRSS,LRIDT,0),U,3) W !?5,"Some Data Already Verified"
I '$T,$O(^LR(LRDFN,LRSS,LRIDT,1))>1 W !?5,"Some Unverified Data Already Entered." L -^LR(LRDFN,"CH",LRIDT) Q
;
S I=0 F S I=$O(^TMP("LR",$J,"VTO",I)) Q:I<1 S ^TMP("LR",$J,"VTO",I,"P")=I_U_$$NLT^LRVER1(I)
;
W ! S DIE="^LR("_LRDFN_",""CH"",",DA=LRIDT D ^DIE
I LRA'=1,$D(Y) D Q:LREND
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT
. S DIR(0)="Y",DIR("A")="Do you wish to stop",DIR("B")="Y"
. D ^DIR
. I Y=0 Q
. S LREND=1
. L -^LR(LRDFN,"CH",LRIDT)
;
I $G(LRVX)'="" D
. S X=LRVX,LRFLG="",LRSPEC=+$P(^LR(LRDFN,LRSS,LRIDT,0),U,5)
. I $G(M(LRFLD)) S LRTS=M(LRFLD)
. E S LRTS=$O(^LAB(60,"C",LRSS_";"_LRFLD_";1",0))
. K LRSB S LRSB=LRFLD
. D V25^LRVER5
;
STOR ; Store other info with results
I '$G(LRNOW) S LRNOW=$$NOW^XLFDT
I $P($G(^LR(LRDFN,LRSS,LRIDT,LRFLD)),U)'="" D
. N LRX,LRXX,LRP,X
. S (LRSB(LRFLD),X)=^LR(LRDFN,LRSS,LRIDT,LRFLD),X=$P(LRSB(LRFLD),U)
. I $G(LRDEL)'="" D DELTA
. D RANGE^LRVER5
. S LRXX=LRSB(LRFLD),$P(LRXX,U)=X
. S $P(LRXX,U,2)=LRFLG,$P(LRXX,U,4)=DUZ,$P(LRXX,U,9)=$G(DUZ(2))
. S $P(LRXX,U,5)=$TR(LRNG,U,"!")
. S $P(LRXX,U,6)=LRNOW
. K ^TMP("LR",$J,"TMP")
. S LRP=$O(^LAB(60,"C",LRSS_";"_LRFLD_";1",0))
. S ^TMP("LR",$J,"TMP",LRFLD)=LRP
. S LRX=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTESTSV,0)),U,9)
. I LRX,LRP D
. . S ^TMP("LR",$J,"TMP",LRFLD,"P")=LRX_U_$$NLT^LRVER1(LRX)_"!"_$$RNLT^LRVER1(LRP)
. . S $P(LRXX,U,3)=$P($G(^TMP("LR",$J,"TMP",LRFLD,"P")),U,2)
. S ^LR(LRDFN,LRSS,LRIDT,LRFLD)=LRXX,LRSB(LRFLD)=LRXX
. I $D(^LR(LRDFN,LRSS,LRIDT,0)),$P(^(0),U,8)'[LRMETH S $P(^(0),U,8)=LRMETH_";"_$P(^(0),U,8)
;
I '$D(LRSB(LRFLD)) W ?39,"**NOT STUFFED**",$C(7) L -^LR(LRDFN,"CH",LRIDT) Q
;
; Set reporting site in file #63.
D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
;
N LRCORECT S LRCORECT=0
D VER^LRVER3A,REQ W ?45,"STUFFED"
I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D LOOK^LRCAPV1
S ^LRO(68,"AC",LRDFN,LRIDT,LRFLD)=""
;
L -^LR(LRDFN,"CH",LRIDT)
;
; Check if LEDI specimen and trigger sending results
I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3^LRVER3
;
Q
;
;
RANGE ; Called from LRSTUF1
F R=$P(LRAC,"-",1):1:$P(LRAC,"-",2) S LRAC(R)=""
Q
;
;
REQ ; Called from above - handle pending required tests.
N LRX,X
S X=0
F S X=$O(M(X)) Q:X<1 S I=M(X) I $P($G(^LR(LRDFN,"CH",LRIDT,X)),U)="" D
. S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)=I_U_LROUTINE,$P(^(0),U,9)=$P($G(^TMP("LR",$J,"TMP",LRFLD,"P")),U)
. S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",I,I)=""
. S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=""
. S LRX=$G(^LR(LRDFN,"CH",LRIDT,X))
. S $P(LRX,"^")="pending"
. I $P(LRX,"^",3)="" S $P(LRX,U,3)=$P($G(^TMP("LR",$J,"TMP",LRFLD,"P")),U,2)
. S $P(LRX,"^",4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
. S $P(LRX,"^",9)=$S($G(DUZ(2)):DUZ(2),1:"")
. S ^LR(LRDFN,"CH",LRIDT,X)=LRX
Q
;
;
DELTA ; Execute delta check
; Setup expected variables for delta check - LRLDT, X, X1
; X2 (delta value) set in V25^LRVER5 call above
;
N LRLDT,LROK,LRTM60,LRQ,LRX,X1
;
; Calculate days back for delta check based on specimen collection date/time.
S LRTM60=$$LRTM60^LRVR(LRCDT)
;
S LRLDT=LRIDT,LROK=0,X1=""
F S LRLDT=$O(^LR(LRDFN,LRSS,LRLDT)) Q:LRLDT<1 D Q:LRLDT<1!(LROK)
. I LRLDT>LRTM60 S LRLDT=-1 Q
. I $P(^LR(LRDFN,LRSS,LRLDT,0),U,5)'=LRSPEC!'$P(^(0),U,3) Q
. I $D(^LR(LRDFN,LRSS,LRLDT,LRFLD)) S X1=$P(^LR(LRDFN,LRSS,LRLDT,LRFLD),U),LROK=1
S X=$P(^LR(LRDFN,LRSS,LRIDT,LRFLD),U)
S LRQ=1 D XDELTACK^LRVERA
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSTUF2 5080 printed Apr 09, 2024@21:10:30 Page 2
LRSTUF2 ;DALOI/STAFF - MASS DATA ENTRY INTO FILE 63.04 ;07/12/12 17:03
+1 ;;5.2;LAB SERVICE;**121,153,263,347,350,461**;Sep 27, 1994;Build 15
+2 ;
LRSTUFF ;
+1 NEW LRCDT
+2 WRITE !,"Acc #: ",LRAN
+3 ;
+4 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))!'$DATA(^(3))
WRITE !," not set up."
QUIT
+5 ;
+6 ;Check for test on accession
+7 ;Also, prevent stuffing of merged or cancelled accessions
+8 ;
+9 NEW LRMTST,LRTCHK,LRMSTR,LRNOP
+10 SET (LRMTST,LRNOP)=0
SET LRTCHK=""
+11 FOR
SET LRMTST=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRMTST))
if 'LRMTST
QUIT
Begin DoDot:1
+12 ;adding a $G because there is one for this global reference in other routines
+13 SET LRMSTR=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRMTST,0))
+14 IF LRTESTSV'=+LRMSTR
QUIT
+15 SET LRNOP=1
+16 IF $PIECE(LRMSTR,U,6)="*Not Performed"
SET LRTCHK="previously cancelled"
+17 IF $PIECE(LRMSTR,U,6)="*Merged"
SET LRTCHK="merged to another accession"
End DoDot:1
+18 IF 'LRNOP
WRITE " doesn't have the selected test."
QUIT
+19 IF LRTCHK]""
WRITE " not stuffed because ",LRTCHK
QUIT
+20 ;
+21 SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRODT=$PIECE(^(0),U,4)
SET LRSN=$PIECE(^(0),U,5)
+22 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
DO PT^LRX
+23 WRITE ?15,PNM,?45,SSN
+24 if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
QUIT
+25 ;
+26 SET LRCDT=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U)
SET LRIDT=$PIECE(^(3),U,5)
SET LRMETH="(BD)"_DUZ_"/"_DUZ(2)
+27 IF LRDPF'=62.3
SET LRLLOC=$PIECE(^(0),U,7)
if LRLLOC=""
SET LRLLOC="UNKNOWN"
WRITE ?65,LRLLOC
+28 ;
+29 LOCK +^LR(LRDFN,"CH",LRIDT):DILOCKTM
+30 IF '$TEST
WRITE !!,"Someone else is editing this entry ",!,$CHAR(7)
QUIT
+31 ;
+32 IF $PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,3)
IF ("pending"'[$SELECT($DATA(^(LRFLD)):$PIECE(^(LRFLD),U,1),1:"pending"))
WRITE !?25,"VERIFIED DATA, CAN'T CHANGE"
LOCK -^LR(LRDFN,"CH",LRIDT)
QUIT
+33 IF $PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,3)
WRITE !?5,"Some Data Already Verified"
+34 IF '$TEST
IF $ORDER(^LR(LRDFN,LRSS,LRIDT,1))>1
WRITE !?5,"Some Unverified Data Already Entered."
LOCK -^LR(LRDFN,"CH",LRIDT)
QUIT
+35 ;
+36 SET I=0
FOR
SET I=$ORDER(^TMP("LR",$JOB,"VTO",I))
if I<1
QUIT
SET ^TMP("LR",$JOB,"VTO",I,"P")=I_U_$$NLT^LRVER1(I)
+37 ;
+38 WRITE !
SET DIE="^LR("_LRDFN_",""CH"","
SET DA=LRIDT
DO ^DIE
+39 IF LRA'=1
IF $DATA(Y)
Begin DoDot:1
+40 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+41 SET DIR(0)="Y"
SET DIR("A")="Do you wish to stop"
SET DIR("B")="Y"
+42 DO ^DIR
+43 IF Y=0
QUIT
+44 SET LREND=1
+45 LOCK -^LR(LRDFN,"CH",LRIDT)
End DoDot:1
if LREND
QUIT
+46 ;
+47 IF $GET(LRVX)'=""
Begin DoDot:1
+48 SET X=LRVX
SET LRFLG=""
SET LRSPEC=+$PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,5)
+49 IF $GET(M(LRFLD))
SET LRTS=M(LRFLD)
+50 IF '$TEST
SET LRTS=$ORDER(^LAB(60,"C",LRSS_";"_LRFLD_";1",0))
+51 KILL LRSB
SET LRSB=LRFLD
+52 DO V25^LRVER5
End DoDot:1
+53 ;
STOR ; Store other info with results
+1 IF '$GET(LRNOW)
SET LRNOW=$$NOW^XLFDT
+2 IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,LRFLD)),U)'=""
Begin DoDot:1
+3 NEW LRX,LRXX,LRP,X
+4 SET (LRSB(LRFLD),X)=^LR(LRDFN,LRSS,LRIDT,LRFLD)
SET X=$PIECE(LRSB(LRFLD),U)
+5 IF $GET(LRDEL)'=""
DO DELTA
+6 DO RANGE^LRVER5
+7 SET LRXX=LRSB(LRFLD)
SET $PIECE(LRXX,U)=X
+8 SET $PIECE(LRXX,U,2)=LRFLG
SET $PIECE(LRXX,U,4)=DUZ
SET $PIECE(LRXX,U,9)=$GET(DUZ(2))
+9 SET $PIECE(LRXX,U,5)=$TRANSLATE(LRNG,U,"!")
+10 SET $PIECE(LRXX,U,6)=LRNOW
+11 KILL ^TMP("LR",$JOB,"TMP")
+12 SET LRP=$ORDER(^LAB(60,"C",LRSS_";"_LRFLD_";1",0))
+13 SET ^TMP("LR",$JOB,"TMP",LRFLD)=LRP
+14 SET LRX=+$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTESTSV,0)),U,9)
+15 IF LRX
IF LRP
Begin DoDot:2
+16 SET ^TMP("LR",$JOB,"TMP",LRFLD,"P")=LRX_U_$$NLT^LRVER1(LRX)_"!"_$$RNLT^LRVER1(LRP)
+17 SET $PIECE(LRXX,U,3)=$PIECE($GET(^TMP("LR",$JOB,"TMP",LRFLD,"P")),U,2)
End DoDot:2
+18 SET ^LR(LRDFN,LRSS,LRIDT,LRFLD)=LRXX
SET LRSB(LRFLD)=LRXX
+19 IF $DATA(^LR(LRDFN,LRSS,LRIDT,0))
IF $PIECE(^(0),U,8)'[LRMETH
SET $PIECE(^(0),U,8)=LRMETH_";"_$PIECE(^(0),U,8)
End DoDot:1
+20 ;
+21 IF '$DATA(LRSB(LRFLD))
WRITE ?39,"**NOT STUFFED**",$CHAR(7)
LOCK -^LR(LRDFN,"CH",LRIDT)
QUIT
+22 ;
+23 ; Set reporting site in file #63.
+24 DO SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
+25 ;
+26 NEW LRCORECT
SET LRCORECT=0
+27 DO VER^LRVER3A
DO REQ
WRITE ?45,"STUFFED"
+28 IF $PIECE(LRPARAM,U,14)
IF $PIECE($GET(^LRO(68,LRAA,0)),U,16)
DO LOOK^LRCAPV1
+29 SET ^LRO(68,"AC",LRDFN,LRIDT,LRFLD)=""
+30 ;
+31 LOCK -^LR(LRDFN,"CH",LRIDT)
+32 ;
+33 ; Check if LEDI specimen and trigger sending results
+34 IF $PIECE($GET(LRORU3),U,3)
IF $ORDER(LRSB(0))
DO LRORU3^LRVER3
+35 ;
+36 QUIT
+37 ;
+38 ;
RANGE ; Called from LRSTUF1
+1 FOR R=$PIECE(LRAC,"-",1):1:$PIECE(LRAC,"-",2)
SET LRAC(R)=""
+2 QUIT
+3 ;
+4 ;
REQ ; Called from above - handle pending required tests.
+1 NEW LRX,X
+2 SET X=0
+3 FOR
SET X=$ORDER(M(X))
if X<1
QUIT
SET I=M(X)
IF $PIECE($GET(^LR(LRDFN,"CH",LRIDT,X)),U)=""
Begin DoDot:1
+4 SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)=I_U_LROUTINE
SET $PIECE(^(0),U,9)=$PIECE($GET(^TMP("LR",$JOB,"TMP",LRFLD,"P")),U)
+5 SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",I,I)=""
+6 SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=""
+7 SET LRX=$GET(^LR(LRDFN,"CH",LRIDT,X))
+8 SET $PIECE(LRX,"^")="pending"
+9 IF $PIECE(LRX,"^",3)=""
SET $PIECE(LRX,U,3)=$PIECE($GET(^TMP("LR",$JOB,"TMP",LRFLD,"P")),U,2)
+10 SET $PIECE(LRX,"^",4)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+11 SET $PIECE(LRX,"^",9)=$SELECT($GET(DUZ(2)):DUZ(2),1:"")
+12 SET ^LR(LRDFN,"CH",LRIDT,X)=LRX
End DoDot:1
+13 QUIT
+14 ;
+15 ;
DELTA ; Execute delta check
+1 ; Setup expected variables for delta check - LRLDT, X, X1
+2 ; X2 (delta value) set in V25^LRVER5 call above
+3 ;
+4 NEW LRLDT,LROK,LRTM60,LRQ,LRX,X1
+5 ;
+6 ; Calculate days back for delta check based on specimen collection date/time.
+7 SET LRTM60=$$LRTM60^LRVR(LRCDT)
+8 ;
+9 SET LRLDT=LRIDT
SET LROK=0
SET X1=""
+10 FOR
SET LRLDT=$ORDER(^LR(LRDFN,LRSS,LRLDT))
if LRLDT<1
QUIT
Begin DoDot:1
+11 IF LRLDT>LRTM60
SET LRLDT=-1
QUIT
+12 IF $PIECE(^LR(LRDFN,LRSS,LRLDT,0),U,5)'=LRSPEC!'$PIECE(^(0),U,3)
QUIT
+13 IF $DATA(^LR(LRDFN,LRSS,LRLDT,LRFLD))
SET X1=$PIECE(^LR(LRDFN,LRSS,LRLDT,LRFLD),U)
SET LROK=1
End DoDot:1
if LRLDT<1!(LROK)
QUIT
+14 SET X=$PIECE(^LR(LRDFN,LRSS,LRIDT,LRFLD),U)
+15 SET LRQ=1
DO XDELTACK^LRVERA
+16 ;
+17 QUIT
