source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIVTL6.m@ 623

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1LAMIVTL6 ;DAL/HOAK Vitek setup 031896
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12**;Sep 27,1994
3INIT ;
4 ; This process works with LAB(61.38, in setting up the vitek
5 ; literal interface
6 I '$G(OK) S OK=1
7CONTROL ;
8 Q:'$D(^LAB(61.38,1,2,1,0)) ;wild card field not set to yes
9 D GETWILD
10 Q
11GETWILD ;
12 I $G(^LAB(61.38,1,2,1,0))=1 D
13 . D PIC
14 . S LRWCRD=0
15 . F S LRWCRD=$O(^LAB(61.38,1,2,1,LRWCRD)) Q:LRWCRD'>0 D
16 .. I ^LAB(61.38,1,2,1,LRWCRD)'="" S LRTIC=^(LRWCRD) D
17 ... S LRCN=^DD(61.382,LRWCRD,0) D RECORD
18 Q
19PIC ;
20 S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
21 S LRWARD=$P(LRX,"^",7)
22 S:LRWARD="" LRWARD="UNK"
23 S LRWRD=LRWARD
24 S LRSERV=$P(LRX,"^",9)
25 S LRTREAT=$S(LRSERV]"":$P(^DIC(45.7,LRSERV,0),"^",1),1:"UNK")
26 S LRDOC=$P(LRX,"^",8),LRPHY=LRDOC
27 S:LRDOC]"" LRDOC=$P($G(^VA(200,+LRDOC,0)),U)
28 S:LRDOC="" LRDOC="UNKNOWN"
29 S LRACN1=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
30 S LRSN=$P(LRACN1,U,5)
31 S LRODT1=$P(LRACN1,U,4)
32 S:LRPHY]"" LRBEEP=$G(^VA(200,LRPHY,.13))
33 S:$G(LRBEEP) LRBEEP=$P(LRBEEP,U,8)
34 S LRSPEC=0
35 S LRSPEC=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC)) Q:LRSPEC'>0 D
36 . S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC,0)
37 . S LRSP=$P(^LAB(62,$P(LRX,U,2),0),"^",1)
38 . S LRSI=$P(^LAB(61,+LRX,0),"^",2)
39 S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,3)
40 S LRDC=$P(LRX,"^",1)
41 S LRTC=$P(LRDC,".",2)
42 S LRSPEC=LRSP
43 Q
44EDIT ;
45 ; SAVE BUG. Ab(s) saved in LRD0
46 ; \/
47 S LRB0=$P(^LAB(61.2,+^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,0),0),U)
48 K DIR
49 S DIR(0)="E"
50 S LRPIC=0
51 ;
52 D VERIFY^LAMIVTL4 ;default to time honored editor
53 ;
54 S LRPIC=$O(^LR(LRDFN,LRSUB,LRIDT,3,LRPIC)) Q:LRPIC'>0!('OK) D
55 . S LRBUG=$P(^LAB(61.2,+^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,0),0),U)
56 . I LRBUG'=LRB0 D CHORG QUIT ;don't do Ab(s) they change with new org
57 . S LRRX=1
58 . F S LRRX=$O(^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,LRRX)) Q:+LRRX'>0 D
59 .. S LRNTRP=^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,LRRX)
60 .. S LRDRUG=$P(^LAB(62.06,$O(^LAB(62.06,"AD",LRRX,0)),0),U)
61 .. W !,$E(LRDRUG,1,30),?32,$P(LRNTRP,U),?38,$P(LRNTRP,U,2)
62 .. I $G(LRD0(LRRX))'=LRNTRP D CHAB
63 Q
64CHORG ;
65 ;Organism has changed..lets track it.
66 K DIE,DR,DA
67 S DIE="^LR(LRDFN,LRSUB,"
68 S DA=LRIDT
69 S DA(1)=LRDFN,DR=.99_"////"_LRB0_"Was changed to "_LRBUG_" BY "_DUZ_" ON "_DT
70 D ^DIE
71 Q
72CHAB ;
73 K DIE,DR,DA
74 S DIE="^LR(LRDFN,LRSUB,"
75 S DA=LRIDT
76 S DA(1)=LRDFN,DR=99_"///"_LRDRUG_"Was changed to "_LRBUG_" BY "_DUZ_" ON "_DT
77 D ^DIE
78 Q
79RECORD ;
80 S LRTIC=LRTIC_":"
81 S LRTIC=$P(LRCN,LRTIC,2)
82 S LRTIC=$P(LRTIC,";")
83 S LRTAC=$P(LRCN,U)
84 S:$D(LRTIC) LRECORD=LRECORD_LRTAC_@LRTIC_"|"
85 Q
Note: See TracBrowser for help on using the repository browser.