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

LAMIVTL0.m

Go to the documentation of this file. 
  1. LAMIVTL0 ;DAL/HOAK 1st routine for Vitek Literal Verification ;1/22/96  08:30 ;
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,37,42**;Sep 27,1994
  1. INIT ;
  1.  S OK=1
  1.  D CONTROL
  1.  D END
  1.  Q
  1. CONTROL ;
  1.  D INTRO I 'OK D END QUIT
  1.  Q
  1. END ;
  1.  K LRNOTO,LRBUG,LRBUX,LRTIC,LRTAC,LRTAD,LRPIC,LRNODE,LRSUM,LRIFN
  1.  K LRQUANT,LAMIAUTO,LRINST
  1.  ;LR*5.2*37___/\______/\  added to fix undef in LRCAPVM
  1.  Q
  1. INTRO ;FROM LAMIAUT0 BY FHS
  1.  ;-----------------------------------------------------------------
  1.  D ^LRPARAM
  1.  S LRMIDEF=$P(^LAB(69.9,1,1),U,10) S LRMIOTH=$P(^(1),U,11)
  1.  S LRINI=$P(^VA(200,DUZ,0),U,2)
  1.  S LRMICOM=$S($D(^DD(63.31,.01,0)):$P(^(0),U,5,99),1:"S Q9=""1,68,KM"" D COM^LRNUM")
  1.  S LRMICOMS=$P($P(LRMICOM,",",3),"""",1)
  1.  S LRTEC=LRINI
  1.  ;
  1. MACHINE ;
  1.  K DIC
  1.  W @IOF
  1.  D S1
  1.  S DIC="^LAB(62.4,"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Select auto instrument here: "
  1.  D ^DIC I Y=-1 S OK=0 QUIT  ;------------------Back to Control
  1.  S LRINST=+Y
  1.  S LRNODE=Y(0)
  1.  S LRAA=$P(LRNODE,U,11)
  1.  ;----------------------------------------------------------------------
  1.  S LRLL=$P(LRNODE,U,4)  ;-----------> load/work list
  1.  I '$G(LRLL) S OK=0 QUIT  ;--------------------Back to Control
  1.  ;----------------------------------------------------------------------
  1. AREA ;
  1.  K DIC("A") K Y(0)
  1.  S DIC="^LRO(68,"
  1.  S DIC("B")=$P(^LRO(68,LRAA,0),U)
  1.  D ^DIC  ;----------------->ACCESSION AREA
  1.  I Y=-1 S OK=0 QUIT  ;-------------------------Back to Control
  1.  I +Y'=LRAA S LRAA=+Y
  1.  ;-----------------------------------------------------------------------
  1. LRAD ;
  1.  S %DT="AEP"
  1.  S %DT("A")=" Accession date: "
  1.  S %DT("B")=$$FMTE^XLFDT($$CADT^LA7UTIL(LRAA),"1D")
  1.  D DATE^LRWU I Y=-1 S OK=0 QUIT  ;--------------Back to Control
  1.  S LRAD=+Y
  1.  ;-----------------------------------------------------------------------
  1. LMIP ;
  1.  S LRVT=$P(LRNODE,U,15) I '$G(LRVT) S LRVT="VS"
  1.  S LRFMT=$P(^LAB(69.9,1,0),U,11),LRFMT=$S(LRFMT="":"I",1:LRFMT)
  1.  D AUTO^LRCAPV  ;--------------->Work Load
  1.  I Y=-1 S OK=0 QUIT  ;--------------------------Back to Control
  1.  ;-----------------------------------------------------------------------
  1. ACCN ;
  1.  I '$D(^LAH(LRLL,1,"C")) S OK=0 D NODATA QUIT  ;no data in LAH
  1.  S OK=1
  1.  K DIR
  1.  S LRAN=0
  1.  F  S LRAN=$O(^LAH(LRLL,1,"C",LRAN)) Q:LRAN'>0  D  Q:'OK
  1.  .  S DIR(0)="N"
  1.  .  S DIR("A")="Enter the number portion of the Accession"
  1.  .  S DIR("B")=LRAN
  1.  .  S DIR("?")="^D LIST^LAMIVTL0"
  1.  .  D ^DIR
  1.  .  I $D(DUOUT)!($D(DTOUT)) S OK=0 QUIT  ;---------Back to Control
  1.  .  I Y'=LRAN S LRAN=+Y
  1.  .  S LRANX=LRAN
  1.  .  ;LA*5.2*37 Check for accns not in Vista
  1.  .  I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D REMOVE QUIT
  1.  .  ;
  1.  .  ;^LAH(65,1,"C",3,32)
  1.  .  D LRIFN
  1.  Q:'OK  D:$G(OK1)'>0 LIST
  1.  G:$G(OK1)'>0 ACCN
  1.  Q
  1. S1 ;
  1.  W !!,"          Vitek Literal verification screen 1",!
  1.  Q
  1.  ;---------------------------------------------------------------------
  1. LIST ;
  1.  W !!
  1.  S LRLIST=0
  1.  W !,"Choose from: "
  1.  F  S LRLIST=$O(^LAH(LRLL,1,"C",LRLIST)) Q:LRLIST=""  D
  1.  .  W !,LRLIST
  1.  Q
  1. REMOVE ;
  1.  ;
  1.  ;--^LAH(65,1,"C",3659,69) = 
  1.  ;_____________________/\                     
  1.  ;            \/
  1.  ;--^LAH(65,1,69,0) = 1^1^^^3659^^VITEK^3659
  1.  ;--^LAH(65,1,69,2,2) = CARD^gni
  1.  ;--^LAH(65,1,69,3,1,0) = 1^^gni
  1.  ;
  1.  ;
  1.  S DIR("A")=$P(^LRO(68,12,0),U)_" "_LRAN_" is not in Vista data base. I've removed the C x-ref Shall I remove ^LAH Data?"
  1.  S DIR(0)="Y" S DIR("B")="YES"
  1.  D ^DIR
  1.  I $D(DTOUT)!($D(DUOUT)) S OK=0 QUIT
  1.  ;
  1.  I Y=1 D
  1.  .  S LRTIC=0
  1.  .  F  S LRTIC=$O(^LAH(LRLL,1,"C",LRAN,LRTIC)) Q:+LRTIC'>0  D
  1.  ..  I $D(^LAH(LRLL,1,LRTIC,0)) K ^LAH(LRLL,1,LRTIC)
  1.  K ^LAH(LRLL,1,"C",LRAN)
  1.  K ^LAH(LRLL,1,"E",LRAN)
  1.  ;
  1.  ;
  1.  W !,"Please continue...",!
  1.  Q
  1. LRIFN ;
  1.  S OK1=1
  1.  S LRIFN=0,LRCNT=0
  1.  F  S LRIFN=$O(^LAH(LRLL,1,"C",LRAN,LRIFN)) Q:LRIFN'>0  D  Q:'OK1
  1.  .  S LRCNT=LRCNT+1
  1.  .  S LRIFN(LRCNT)=LRIFN
  1.  I '$G(LRCNT) W !!,"There is no data in LAH for accession ",LRAN S OK1=0 QUIT
  1.  Q:'OK1
  1.  D ^LAMIVTL5  ;check for zero isolate
  1.  Q:'OK
  1.  D ^LAMIVTL1  ;continue processing
  1.  D END
  1.  Q
  1. NODATA ;
  1.  W !!," There is no data in LAH. Run another upload "
  1.  Q