LAMIVTL5.m

LAMIVTL5 ;VA/DAL/HOAK - Verify for Vitek literal isolate 0  ;7/8/96  07:30 ;

 ;;5.2;AUTOMATED LAB INSTRUMENTS;**1030**;NOV 01, 1997

 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,36**;Sep 27,1994;Build 7

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

LAMIVTL5  ;VA/DAL/HOAK - Verify for Vitek literal isolate 0  ;7/8/96  07:30 ;

 +1       ;;5.2;AUTOMATED LAB INSTRUMENTS;**1030**;NOV 01, 1997

 +2       ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,36**;Sep 27,1994;Build 7

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