Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRSTUF2

LRSTUF2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. LRSTUFF ;
  1.  N LRCDT
  1.  W !,"Acc #: ",LRAN
  1.  ;
  1.  I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))!'$D(^(3)) W !," not set up." Q
  1.  ;
  1.  ;Check for test on accession
  1.  ;Also, prevent stuffing of merged or cancelled accessions
  1.  ;
  1.  N LRMTST,LRTCHK,LRMSTR,LRNOP
  1.  S (LRMTST,LRNOP)=0,LRTCHK=""
  1.  F  S LRMTST=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRMTST)) Q:'LRMTST  D
  1.  . ;adding a $G because there is one for this global reference in other routines
  1.  . S LRMSTR=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRMTST,0))
  1.  . I LRTESTSV'=+LRMSTR Q
  1.  . S LRNOP=1
  1.  . I $P(LRMSTR,U,6)="*Not Performed" S LRTCHK="previously cancelled"
  1.  . I $P(LRMSTR,U,6)="*Merged" S LRTCHK="merged to another accession"
  1.  I 'LRNOP W " doesn't have the selected test." Q
  1.  I LRTCHK]"" W " not stuffed because ",LRTCHK Q
  1.  ;
  1.  S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRODT=$P(^(0),U,4),LRSN=$P(^(0),U,5)
  1.  S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
  1.  W ?15,PNM,?45,SSN
  1.  Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
  1.  ;
  1.  S LRCDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U),LRIDT=$P(^(3),U,5),LRMETH="(BD)"_DUZ_"/"_DUZ(2)
  1.  I LRDPF'=62.3 S LRLLOC=$P(^(0),U,7) S:LRLLOC="" LRLLOC="UNKNOWN" W ?65,LRLLOC
  1.  ;
  1.  L +^LR(LRDFN,"CH",LRIDT):DILOCKTM
  1.  I '$T W !!,"Someone else is editing this entry ",!,$C(7) Q
  1.  ;
  1.  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
  1.  I $P(^LR(LRDFN,LRSS,LRIDT,0),U,3) W !?5,"Some Data Already Verified"
  1.  I '$T,$O(^LR(LRDFN,LRSS,LRIDT,1))>1 W !?5,"Some Unverified Data Already Entered." L -^LR(LRDFN,"CH",LRIDT) Q
  1.  ;
  1.  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)
  1.  ;
  1.  W ! S DIE="^LR("_LRDFN_",""CH"",",DA=LRIDT D ^DIE
  1.  I LRA'=1,$D(Y) D  Q:LREND
  1.  . N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  . S DIR(0)="Y",DIR("A")="Do you wish to stop",DIR("B")="Y"
  1.  . D ^DIR
  1.  . I Y=0 Q
  1.  . S LREND=1
  1.  . L -^LR(LRDFN,"CH",LRIDT)
  1.  ;
  1.  I $G(LRVX)'="" D
  1.  . S X=LRVX,LRFLG="",LRSPEC=+$P(^LR(LRDFN,LRSS,LRIDT,0),U,5)
  1.  . I $G(M(LRFLD)) S LRTS=M(LRFLD)
  1.  . E  S LRTS=$O(^LAB(60,"C",LRSS_";"_LRFLD_";1",0))
  1.  . K LRSB S LRSB=LRFLD
  1.  . D V25^LRVER5
  1.  ;
  1. STOR ; Store other info with results
  1.  I '$G(LRNOW) S LRNOW=$$NOW^XLFDT
  1.  I $P($G(^LR(LRDFN,LRSS,LRIDT,LRFLD)),U)'="" D
  1.  . N LRX,LRXX,LRP,X
  1.  . S (LRSB(LRFLD),X)=^LR(LRDFN,LRSS,LRIDT,LRFLD),X=$P(LRSB(LRFLD),U)
  1.  . I $G(LRDEL)'="" D DELTA
  1.  . D RANGE^LRVER5
  1.  . S LRXX=LRSB(LRFLD),$P(LRXX,U)=X
  1.  . S $P(LRXX,U,2)=LRFLG,$P(LRXX,U,4)=DUZ,$P(LRXX,U,9)=$G(DUZ(2))
  1.  . S $P(LRXX,U,5)=$TR(LRNG,U,"!")
  1.  . S $P(LRXX,U,6)=LRNOW
  1.  . K ^TMP("LR",$J,"TMP")
  1.  . S LRP=$O(^LAB(60,"C",LRSS_";"_LRFLD_";1",0))
  1.  . S ^TMP("LR",$J,"TMP",LRFLD)=LRP
  1.  . S LRX=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTESTSV,0)),U,9)
  1.  . I LRX,LRP D
  1.  . . S ^TMP("LR",$J,"TMP",LRFLD,"P")=LRX_U_$$NLT^LRVER1(LRX)_"!"_$$RNLT^LRVER1(LRP)
  1.  . . S $P(LRXX,U,3)=$P($G(^TMP("LR",$J,"TMP",LRFLD,"P")),U,2)
  1.  . S ^LR(LRDFN,LRSS,LRIDT,LRFLD)=LRXX,LRSB(LRFLD)=LRXX
  1.  . I $D(^LR(LRDFN,LRSS,LRIDT,0)),$P(^(0),U,8)'[LRMETH S $P(^(0),U,8)=LRMETH_";"_$P(^(0),U,8)
  1.  ;
  1.  I '$D(LRSB(LRFLD)) W ?39,"**NOT STUFFED**",$C(7) L -^LR(LRDFN,"CH",LRIDT) Q
  1.  ;
  1.  ; Set reporting site in file #63.
  1.  D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
  1.  ;
  1.  N LRCORECT S LRCORECT=0
  1.  D VER^LRVER3A,REQ W ?45,"STUFFED"
  1.  I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D LOOK^LRCAPV1
  1.  S ^LRO(68,"AC",LRDFN,LRIDT,LRFLD)=""
  1.  ;
  1.  L -^LR(LRDFN,"CH",LRIDT)
  1.  ;
  1.  ; Check if LEDI specimen and trigger sending results
  1.  I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3^LRVER3
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. RANGE ; Called from LRSTUF1
  1.  F R=$P(LRAC,"-",1):1:$P(LRAC,"-",2) S LRAC(R)=""
  1.  Q
  1.  ;
  1.  ;
  1. REQ ; Called from above - handle pending required tests.
  1.  N LRX,X
  1.  S X=0
  1.  F  S X=$O(M(X)) Q:X<1  S I=M(X) I $P($G(^LR(LRDFN,"CH",LRIDT,X)),U)="" D
  1.  . 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)
  1.  . S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",I,I)=""
  1.  . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=""
  1.  . S LRX=$G(^LR(LRDFN,"CH",LRIDT,X))
  1.  . S $P(LRX,"^")="pending"
  1.  . I $P(LRX,"^",3)="" S $P(LRX,U,3)=$P($G(^TMP("LR",$J,"TMP",LRFLD,"P")),U,2)
  1.  . S $P(LRX,"^",4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1.  . S $P(LRX,"^",9)=$S($G(DUZ(2)):DUZ(2),1:"")
  1.  . S ^LR(LRDFN,"CH",LRIDT,X)=LRX
  1.  Q
  1.  ;
  1.  ;
  1. DELTA ; Execute delta check
  1.  ; Setup expected variables for delta check - LRLDT, X, X1
  1.  ; X2 (delta value) set in V25^LRVER5 call above
  1.  ;
  1.  N LRLDT,LROK,LRTM60,LRQ,LRX,X1
  1.  ;
  1.  ; Calculate days back for delta check based on specimen collection date/time.
  1.  S LRTM60=$$LRTM60^LRVR(LRCDT)
  1.  ;
  1.  S LRLDT=LRIDT,LROK=0,X1=""
  1.  F  S LRLDT=$O(^LR(LRDFN,LRSS,LRLDT)) Q:LRLDT<1  D  Q:LRLDT<1!(LROK)
  1.  . I LRLDT>LRTM60 S LRLDT=-1 Q
  1.  . I $P(^LR(LRDFN,LRSS,LRLDT,0),U,5)'=LRSPEC!'$P(^(0),U,3) Q
  1.  . I $D(^LR(LRDFN,LRSS,LRLDT,LRFLD)) S X1=$P(^LR(LRDFN,LRSS,LRLDT,LRFLD),U),LROK=1
  1.  S X=$P(^LR(LRDFN,LRSS,LRIDT,LRFLD),U)
  1.  S LRQ=1 D XDELTACK^LRVERA
  1.  ;
  1.  Q