| 1 | LAMIVTL6 ;DAL/HOAK Vitek setup 031896
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**12**;Sep 27,1994
|
|---|
| 3 | INIT ;
|
|---|
| 4 | ; This process works with LAB(61.38, in setting up the vitek
|
|---|
| 5 | ; literal interface
|
|---|
| 6 | I '$G(OK) S OK=1
|
|---|
| 7 | CONTROL ;
|
|---|
| 8 | Q:'$D(^LAB(61.38,1,2,1,0)) ;wild card field not set to yes
|
|---|
| 9 | D GETWILD
|
|---|
| 10 | Q
|
|---|
| 11 | GETWILD ;
|
|---|
| 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
|
|---|
| 19 | PIC ;
|
|---|
| 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
|
|---|
| 44 | EDIT ;
|
|---|
| 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
|
|---|
| 64 | CHORG ;
|
|---|
| 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
|
|---|
| 72 | CHAB ;
|
|---|
| 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
|
|---|
| 79 | RECORD ;
|
|---|
| 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
|
|---|
