source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIVTL5.m@ 1783

Last change on this file since 1783 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.2 KB
Line 
1LAMIVTL5 ;DAL/HOAK Verify for Vitek literal isolate 0 ;7/8/96 07:30 ;
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,36**;Sep 27,1994
3INIT ;
4 S OK=1
5 K ^TMP("LRISO1",$J)
6ZEROCHK ;
7 S LRX1=0
8 ;
9 Q:'$D(^LAH(LRLL,"ISO",LRAN))
10 Q:'$D(^LAH(LRLL,"ISO",LRAN,0))
11 ;---WE got `em 0s
12 S LRTIC=0 ;--Looking for all the isolates for this accn
13 ;
14 F S LRTIC=$O(^LAH(LRLL,"ISO",LRAN,LRTIC)) Q:+LRTIC'>0 D
15 . I LRTIC>0 S ^TMP("LRISO1",$J,LRTIC)=""
16 ;
17 ;
18 I $D(^LAB(61.38,1,3)) S LRX1=$G(^LAB(61.38,1,3))
19 I $G(LRX1)'>0 S LRX1=99
20CHANGE ;
21 S FIXED=""
22 I '$D(^LAH(LRLL,"ISO",LRAN,LRX1)) D
23 . ;
24 . S FIXED=1
25 . S ^LAH(LRLL,"ISO",LRAN,LRX1)=^LAH(LRLL,"ISO",LRAN,0)
26 . ;
27 . ;--Change all the zeros to LRX1
28 . S LRPIC=0
29 . F S LRPIC=$O(^LAH(LRLL,1,LRPIC)) Q:+LRPIC'>0 D
30 .. S LRTAC=-1
31 .. S LRTAC=$O(^LAH(LRLL,1,LRPIC,3,LRTAC)) Q:LRTAC'=0
32 .. S %Y="^LAH(LRLL,1,LRPIC,3,LRX1,",%X="^LAH(LRLL,1,LRPIC,3,LRTAC,"
33 .. D %XY^%RCR
34 .. K ^LAH(LRLL,1,LRPIC,3,0)
35 .. ;
36 .. K ^LAH(LRLL,"ISO",LRAN,0)
37 ;
38 I 'FIXED D NOTONE
39 Q
40 ;
41NOTONE ;
42 ;--cant use one
43 Q:FIXED
44 S LRNUM5=0
45 F S LRNUM5=$O(^TMP("LRISO1",$J,LRNUM5)) Q:+LRNUM5'>0 S LRX1=LRNUM5
46 ;S LRX1=LRX1+1
47 I LRX1'=99 S LRX1=99
48 I 'FIXED D CHANGE
49 ;
50 Q
Note: See TracBrowser for help on using the repository browser.