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

LAMIVTL1.m

Go to the documentation of this file. 
  1. LAMIVTL1 ;DAL/HOAK 2nd Vitek literal verify rtn
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,29**;Sep 27,1994
  1. INIT ;
  1.  S OK=1
  1.  S LREND=0
  1.  D CONTROL
  1.  Q
  1. CONTROL ;
  1.  W @IOF
  1.  D SETUP Q:'OK
  1.  D EXP Q:'OK
  1.  D ^LAMIVTL2
  1.  Q
  1. SETUP ;
  1.  ; Set up variables for PROCESSING
  1.  S LRAN=LRANX
  1.  ;I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN)) S OK=0 QUIT  ;-----Back to Control
  1.  S LRNODE=^LRO(68,LRAA,1,LRAD,1,LRAN,0) S LRACCN=^(.2)
  1.  S LRDFN=+LRNODE
  1.  S LRDPF=$P(LRNODE,U,2)
  1.  S LRLLOC=$P(LRNODE,U,7)
  1.  S LRPHY=$P(LRNODE,U,8)
  1.  S LRODT=$P(LRNODE,U,4)
  1.  S LRSN=$P(LRNODE,U,5)
  1.  ;---------------------------------------------------------------------
  1.  ; Reset LRNODE----------------------------------------------\/
  1.  S LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5) S LRNODE=^(3)
  1.  S LRCDT=$P(LRNODE,U)
  1.  S LRDTR=$P(LRNODE,U,3)
  1.  S LREAL=$P(LRNODE,U,2)
  1.  S LRSUB=$P(^LRO(68,LRAA,0),U,2)
  1.  ;----------------------------------------------------------------------
  1. EN ; From LAMIAUT0 BY FHS
  1.  S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0)) I $D(^(LRI,0)) D
  1.  .  S LRSPEC=+^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRI,0),LRSAMP=+$P(^(0),U,2)
  1.  S DFN=$P(^LR(LRDFN,0),U,3)
  1.  S LRPHYN=$S($D(^VA(200,+LRPHY,0)):$P(^(0),U),1:"Unknown")
  1.  ;----------------------------------------------------------------------
  1. PAT ;
  1.  D PT^LRX
  1.  W !,"ACC # (",LRAN,")    "
  1.  W $$DTF^LRAFUNC1(LRCDT),!!?10,PNM,"   SSN: ",SSN,"   LOC: ",LRLLOC
  1.  W !?5,"Specimen: "
  1.  W $S($D(^LAB(61,+LRSPEC,0)):$P(^(0),U),1:"Unknown")
  1.  W "    Sample: ",$S($D(^LAB(62,+LRSAMP,0)):$P(^(0),U),1:"Unknown"),!
  1.  I $D(^LRO(69,LRODT,1,LRSN,6,+$O(^LRO(69,LRODT,1,LRSN,6,0)),0)) D
  1.  .  W !," Comment on Specimem    "
  1.  S I=0
  1.  F A=0:0 S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I=""  W ?30,^(I,0),!
  1.  I $D(^LR(LRDFN,"MI",LRIDT,2,+$O(^LR(LRDFN,"MI",LRIDT,2,0)),0)) D
  1.  .  W !,"GRAM STAIN "
  1.  .  S I=0
  1.  .  F A=0:0 S I=$O(^LR(LRDFN,"MI",LRIDT,2,I)) Q:I=""  W ?15,^(I,0),!
  1.  I $D(^LR(LRDFN,"MI",LRIDT,99)) W !,"Comment on Specimen : ",^(99)
  1.  S %=1
  1.  W !!?10,"Is this the correct patient/specimen? "
  1.  D YN^DICN
  1.  I %'=1 S OK=0 QUIT
  1.  QUIT
  1. EXP ; From LAMIAUT4 BY FHS
  1.  ;---------------------------------------------------------------------
  1.  ;Get the list of tests for this ACC.
  1.  W !!,PNM,"   ",SSN,!,LRACCN
  1.  D INF^LRX
  1.  W !!?5,$P(^LAB(61,LRSPEC,0),U),"  ",$P(^LAB(62,LRSAMP,0),U),!
  1.  K ^TMP("LR",$J),LRTEST,LRNAME,LRTS
  1.  S N=0
  1.  F I=0:0 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1  D
  1.  .  S N=N+1,LRTEST(N)=+^(I,0)
  1.  S LRNTN=N
  1.  F I=1:1:N D
  1.  .  S:$D(^LAB(60,+LRTEST(I),0)) LRTEST(I)=LRTEST(I)_U_^(0) D
  1.  ..  S LRNAME(I)=$P(LRTEST(I),U,2)
  1.  ..  S LRNAME(I,+LRTEST(I))=""
  1.  ..  S LRTS(I)=LRNAME(I)
  1.  ..  S LRTS(I,+LRTEST(I))=""
  1.  S LRALL=""
  1.  F I=1:1:LRNTN I $D(LRNAME(I)) D
  1.  .  S LRTS=+$O(LRNAME(I,0))
  1.  .  S LRALL=LRALL_","_I
  1.  .  W !,I,"  ",LRNAME(I) D
  1.  ..  I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+$O(LRNAME(I,0)),0)),$P(^(0),U,5) W ?25," verified" S LRNOTO=1
  1.  ;-----------------------------------------------------------------------
  1. V9 ;
  1.  W !
  1.  S LRALL=$P(LRALL,",",2,99)
  1.  S DIR(0)="F"
  1.  S DIR("A")="Please enter the test number(s) or "
  1.  S DIR("B")="ALL"
  1.  S DIR("?")="Enter ALL, a number, or a range separated by `,' ie 1,2,3."
  1.  D ^DIR
  1.  S:$D(DUOUT)!($D(DTOUT)) OK=0 I 'OK S LREND=1
  1.  S:Y="ALL" Y=LRALL S:Y["A" Y=LRALL
  1.  D RANGE^LRWU2 Q:X9=""  X (X9_"S:'$D(LRNAME(T1)) X=0") I X=0 W !!?7,"Incorrect test number ",$C(7) G EXP
  1.  Q