LAMIVTL5 ;DAL/HOAK Verify for Vitek literal isolate 0 ;7/8/96 07:30 ;
;;5.2;AUTOMATED LAB INSTRUMENTS;**12,36**;Sep 27,1994
INIT ;
S OK=1
K ^TMP("LRISO1",$J)
ZEROCHK ;
S LRX1=0
;
Q:'$D(^LAH(LRLL,"ISO",LRAN))
Q:'$D(^LAH(LRLL,"ISO",LRAN,0))
;---WE got `em 0s
S LRTIC=0 ;--Looking for all the isolates for this accn
;
F S LRTIC=$O(^LAH(LRLL,"ISO",LRAN,LRTIC)) Q:+LRTIC'>0 D
. I LRTIC>0 S ^TMP("LRISO1",$J,LRTIC)=""
;
;
I $D(^LAB(61.38,1,3)) S LRX1=$G(^LAB(61.38,1,3))
I $G(LRX1)'>0 S LRX1=99
CHANGE ;
S FIXED=""
I '$D(^LAH(LRLL,"ISO",LRAN,LRX1)) D
. ;
. S FIXED=1
. S ^LAH(LRLL,"ISO",LRAN,LRX1)=^LAH(LRLL,"ISO",LRAN,0)
. ;
. ;--Change all the zeros to LRX1
. S LRPIC=0
. F S LRPIC=$O(^LAH(LRLL,1,LRPIC)) Q:+LRPIC'>0 D
.. S LRTAC=-1
.. S LRTAC=$O(^LAH(LRLL,1,LRPIC,3,LRTAC)) Q:LRTAC'=0
.. S %Y="^LAH(LRLL,1,LRPIC,3,LRX1,",%X="^LAH(LRLL,1,LRPIC,3,LRTAC,"
.. D %XY^%RCR
.. K ^LAH(LRLL,1,LRPIC,3,0)
.. ;
.. K ^LAH(LRLL,"ISO",LRAN,0)
;
I 'FIXED D NOTONE
Q
;
NOTONE ;
;--cant use one
Q:FIXED
S LRNUM5=0
F S LRNUM5=$O(^TMP("LRISO1",$J,LRNUM5)) Q:+LRNUM5'>0 S LRX1=LRNUM5
;S LRX1=LRX1+1
I LRX1'=99 S LRX1=99
I 'FIXED D CHANGE
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAMIVTL5 1237 printed Nov 22, 2024@16:53:43 Page 2
LAMIVTL5 ;DAL/HOAK Verify for Vitek literal isolate 0 ;7/8/96 07:30 ;
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,36**;Sep 27,1994
INIT ;
+1 SET OK=1
+2 KILL ^TMP("LRISO1",$JOB)
ZEROCHK ;
+1 SET LRX1=0
+2 ;
+3 if '$DATA(^LAH(LRLL,"ISO",LRAN))
QUIT
+4 if '$DATA(^LAH(LRLL,"ISO",LRAN,0))
QUIT
+5 ;---WE got `em 0s
+6 ;--Looking for all the isolates for this accn
SET LRTIC=0
+7 ;
+8 FOR
SET LRTIC=$ORDER(^LAH(LRLL,"ISO",LRAN,LRTIC))
if +LRTIC'>0
QUIT
Begin DoDot:1
+9 IF LRTIC>0
SET ^TMP("LRISO1",$JOB,LRTIC)=""
End DoDot:1
+10 ;
+11 ;
+12 IF $DATA(^LAB(61.38,1,3))
SET LRX1=$GET(^LAB(61.38,1,3))
+13 IF $GET(LRX1)'>0
SET LRX1=99
CHANGE ;
+1 SET FIXED=""
+2 IF '$DATA(^LAH(LRLL,"ISO",LRAN,LRX1))
Begin DoDot:1
+3 ;
+4 SET FIXED=1
+5 SET ^LAH(LRLL,"ISO",LRAN,LRX1)=^LAH(LRLL,"ISO",LRAN,0)
+6 ;
+7 ;--Change all the zeros to LRX1
+8 SET LRPIC=0
+9 FOR
SET LRPIC=$ORDER(^LAH(LRLL,1,LRPIC))
if +LRPIC'>0
QUIT
Begin DoDot:2
+10 SET LRTAC=-1
+11 SET LRTAC=$ORDER(^LAH(LRLL,1,LRPIC,3,LRTAC))
if LRTAC'=0
QUIT
+12 SET %Y="^LAH(LRLL,1,LRPIC,3,LRX1,"
SET %X="^LAH(LRLL,1,LRPIC,3,LRTAC,"
+13 DO %XY^%RCR
+14 KILL ^LAH(LRLL,1,LRPIC,3,0)
+15 ;
+16 KILL ^LAH(LRLL,"ISO",LRAN,0)
End DoDot:2
End DoDot:1
+17 ;
+18 IF 'FIXED
DO NOTONE
+19 QUIT
+20 ;
NOTONE ;
+1 ;--cant use one
+2 if FIXED
QUIT
+3 SET LRNUM5=0
+4 FOR
SET LRNUM5=$ORDER(^TMP("LRISO1",$JOB,LRNUM5))
if +LRNUM5'>0
QUIT
SET LRX1=LRNUM5
+5 ;S LRX1=LRX1+1
+6 IF LRX1'=99
SET LRX1=99
+7 IF 'FIXED
DO CHANGE
+8 ;
+9 QUIT
