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

LRGV1.m

Go to the documentation of this file.
  1. LRGV1 ;DALOI/RWF - PART2 OF INSTRUMENT GROUP VERIFY DATA ;2/8/91 09:29
  1. ;;5.2;LAB SERVICE;**112,153,269**;Sep 27, 1994
  1. ;
  1. STUFF ;from LRGV
  1. ;
  1. ; Check if task has been asked to stop.
  1. I $D(ZTQUEUED),$$S^%ZTLOAD D Q
  1. . S ZTSTOP=1
  1. . W !!,"*** Report requested to stop by TaskMan ***"
  1. . W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
  1. ;
  1. N LRQUIT
  1. ;
  1. S LRQUIT=0
  1. ;
  1. L +^LAH(LRLL,1,LRSQ):1
  1. I '$T W !,"Unable to obtain lock on sequence #",LRSQ Q
  1. ;
  1. ; Skip this sequence number if accession number is for a different area/date
  1. S LRSQ(0)=^LAH(LRLL,1,LRSQ,0)
  1. I $P(LRSQ(0),U,3)=LRAA,$P(LRSQ(0),U,4)=LRAD,$P(LRSQ(0),U,5)=LRAN
  1. I '$T L -^LAH(LRLL,1,LRSQ) Q
  1. ;
  1. I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),U,2) D
  1. . W !?5,"Corrupt Accession ",!
  1. . D NOP
  1. ;
  1. S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
  1. S LRDFN=+X,LRODT=+$P(X,U,4),LRSN=+$P(X,U,5),LRLLOC=$P(X,U,7)
  1. S:'$L(LRLLOC) LRLLOC=0
  1. S LRORD=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)),"^")
  1. S X(3)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
  1. S LRIDT=$P(X(3),U,5)
  1. S:'LRIDT LRIDT=9999999-X(3)
  1. S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
  1. ;
  1. K LRSA,LRSB,X
  1. W " Auto Sequence #",LRSQ
  1. I '$D(^LRO(68,+LRAA,1,+LRAD,1,+LRAN,0))!'$D(^(3)) D Q
  1. . W ?40,"Accession NOT found."
  1. . L -^LAH(LRLL,1,LRSQ)
  1. ;
  1. K ^TMP("LR",$J,"TMP")
  1. D TEST^LRVR1
  1. ;
  1. ; Check for more than one sequence relating to this accession
  1. S LRI=0
  1. F S LRI=$O(^LAH(LRLL,1,"C",LRAN,LRI)) Q:'LRI D Q:LRQUIT
  1. . I LRI=LRSQ Q
  1. . S LRI(0)=$G(^LAH(LRLL,1,LRI,0))
  1. . I $P(LRI(0),"^",3,5)'=LRAA_"^"_LRAD_"^"_LRAN Q
  1. . S LRQUIT=1
  1. . D INFO,NOP
  1. I LRQUIT Q
  1. ;
  1. S LRMETH=$P(^LAH(LRLL,1,LRSQ,0),U,7)
  1. I $O(^LAH(LRLL,1,LRSQ,1))<1 D Q
  1. . W ?45,"There's NO Instrument Data "
  1. . D NOP
  1. ;
  1. ; Get patient demographics
  1. S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
  1. S:'$L($G(SEX)) SEX="M"
  1. S:'$L($G(AGE)) AGE=99
  1. W ! D DISPLAY^LRGP
  1. ;
  1. L +^LR(LRDFN,"CH",LRIDT):1
  1. I '$T W !,"Unable to obtain lock on LAB DATA file" Q
  1. ;
  1. S LR0=$G(^LR(LRDFN,"CH",LRIDT,0))
  1. I LR0="" W !,"DATA HEADER MISSING " D NOP Q
  1. ;
  1. S X=+$P(LR0,U,5),LRSPEC=-1,LRSPNAM="??"
  1. I X S LRSPNAM=$P(^LAB(61,+X,0),U,1),LRSPEC=X
  1. W !," Specimen: ",LRSPNAM
  1. W ?26," Collection date/time: ",$$FMTE^XLFDT($P(LR0,"^"),"1M"),!
  1. ;
  1. I LRDPF'=62.3,LRSPEC'=$P(LR0,U,5) D Q
  1. . W !," << SPECIMEN IS NOT ",LRSPNAM," >> "
  1. . D NOP
  1. ;
  1. S LRVF=+$P(LR0,U,3)
  1. I LRVF W !,"Some Data Already Verified ",!
  1. ;
  1. I '$T,$O(^LR(LRDFN,"CH",LRIDT,1))>1 D Q
  1. . W !,"Some Unverified Data Already Entered. "
  1. . D NOP
  1. ;
  1. D ^LRGV2
  1. ;
  1. L -^LR(LRDFN,"CH",LRIDT)
  1. L -^LAH(LRLL,1,LRSQ)
  1. ;
  1. Q
  1. ;
  1. NOP ; unlock from above
  1. L -^LR(LRDFN,"CH",LRIDT)
  1. L -^LAH(LRLL,1,LRSQ)
  1. W !,">> Accession: ",LRAN," NOT VERIFIED <<"
  1. I $E(IOST,1,2)="C-" W $C(7)
  1. Q
  1. ;
  1. ;
  1. INFO ;
  1. N X
  1. W !,"Sequence #: ",LRSQ
  1. S X=^LAH(LRLL,1,LRSQ,0)
  1. ;
  1. I LRWT="T" D
  1. . I $P(X,"^") W ?20,"TRAY: ",$P(X,"^")
  1. . I $P(X,"^",2) W ?33,"CUP: ",$P(X,"^",2)
  1. ;
  1. W ?45,"DUPLICATE "
  1. Q