LAMIVTL6 ;DAL/HOAK Vitek setup 031896
;;5.2;AUTOMATED LAB INSTRUMENTS;**12**;Sep 27,1994
INIT ;
; This process works with LAB(61.38, in setting up the vitek
; literal interface
I '$G(OK) S OK=1
CONTROL ;
Q:'$D(^LAB(61.38,1,2,1,0)) ;wild card field not set to yes
D GETWILD
Q
GETWILD ;
I $G(^LAB(61.38,1,2,1,0))=1 D
. D PIC
. S LRWCRD=0
. F S LRWCRD=$O(^LAB(61.38,1,2,1,LRWCRD)) Q:LRWCRD'>0 D
.. I ^LAB(61.38,1,2,1,LRWCRD)'="" S LRTIC=^(LRWCRD) D
... S LRCN=^DD(61.382,LRWCRD,0) D RECORD
Q
PIC ;
S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
S LRWARD=$P(LRX,"^",7)
S:LRWARD="" LRWARD="UNK"
S LRWRD=LRWARD
S LRSERV=$P(LRX,"^",9)
S LRTREAT=$S(LRSERV]"":$P(^DIC(45.7,LRSERV,0),"^",1),1:"UNK")
S LRDOC=$P(LRX,"^",8),LRPHY=LRDOC
S:LRDOC]"" LRDOC=$P($G(^VA(200,+LRDOC,0)),U)
S:LRDOC="" LRDOC="UNKNOWN"
S LRACN1=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
S LRSN=$P(LRACN1,U,5)
S LRODT1=$P(LRACN1,U,4)
S:LRPHY]"" LRBEEP=$G(^VA(200,LRPHY,.13))
S:$G(LRBEEP) LRBEEP=$P(LRBEEP,U,8)
S LRSPEC=0
S LRSPEC=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC)) Q:LRSPEC'>0 D
. S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC,0)
. S LRSP=$P(^LAB(62,$P(LRX,U,2),0),"^",1)
. S LRSI=$P(^LAB(61,+LRX,0),"^",2)
S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,3)
S LRDC=$P(LRX,"^",1)
S LRTC=$P(LRDC,".",2)
S LRSPEC=LRSP
Q
EDIT ;
; SAVE BUG. Ab(s) saved in LRD0
; \/
S LRB0=$P(^LAB(61.2,+^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,0),0),U)
K DIR
S DIR(0)="E"
S LRPIC=0
;
D VERIFY^LAMIVTL4 ;default to time honored editor
;
S LRPIC=$O(^LR(LRDFN,LRSUB,LRIDT,3,LRPIC)) Q:LRPIC'>0!('OK) D
. S LRBUG=$P(^LAB(61.2,+^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,0),0),U)
. I LRBUG'=LRB0 D CHORG QUIT ;don't do Ab(s) they change with new org
. S LRRX=1
. F S LRRX=$O(^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,LRRX)) Q:+LRRX'>0 D
.. S LRNTRP=^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,LRRX)
.. S LRDRUG=$P(^LAB(62.06,$O(^LAB(62.06,"AD",LRRX,0)),0),U)
.. W !,$E(LRDRUG,1,30),?32,$P(LRNTRP,U),?38,$P(LRNTRP,U,2)
.. I $G(LRD0(LRRX))'=LRNTRP D CHAB
Q
CHORG ;
;Organism has changed..lets track it.
K DIE,DR,DA
S DIE="^LR(LRDFN,LRSUB,"
S DA=LRIDT
S DA(1)=LRDFN,DR=.99_"////"_LRB0_"Was changed to "_LRBUG_" BY "_DUZ_" ON "_DT
D ^DIE
Q
CHAB ;
K DIE,DR,DA
S DIE="^LR(LRDFN,LRSUB,"
S DA=LRIDT
S DA(1)=LRDFN,DR=99_"///"_LRDRUG_"Was changed to "_LRBUG_" BY "_DUZ_" ON "_DT
D ^DIE
Q
RECORD ;
S LRTIC=LRTIC_":"
S LRTIC=$P(LRCN,LRTIC,2)
S LRTIC=$P(LRTIC,";")
S LRTAC=$P(LRCN,U)
S:$D(LRTIC) LRECORD=LRECORD_LRTAC_@LRTIC_"|"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAMIVTL6 2551 printed Dec 13, 2024@01:43:31 Page 2
LAMIVTL6 ;DAL/HOAK Vitek setup 031896
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12**;Sep 27,1994
INIT ;
+1 ; This process works with LAB(61.38, in setting up the vitek
+2 ; literal interface
+3 IF '$GET(OK)
SET OK=1
CONTROL ;
+1 ;wild card field not set to yes
if '$DATA(^LAB(61.38,1,2,1,0))
QUIT
+2 DO GETWILD
+3 QUIT
GETWILD ;
+1 IF $GET(^LAB(61.38,1,2,1,0))=1
Begin DoDot:1
+2 DO PIC
+3 SET LRWCRD=0
+4 FOR
SET LRWCRD=$ORDER(^LAB(61.38,1,2,1,LRWCRD))
if LRWCRD'>0
QUIT
Begin DoDot:2
+5 IF ^LAB(61.38,1,2,1,LRWCRD)'=""
SET LRTIC=^(LRWCRD)
Begin DoDot:3
+6 SET LRCN=^DD(61.382,LRWCRD,0)
DO RECORD
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
PIC ;
+1 SET LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
+2 SET LRWARD=$PIECE(LRX,"^",7)
+3 if LRWARD=""
SET LRWARD="UNK"
+4 SET LRWRD=LRWARD
+5 SET LRSERV=$PIECE(LRX,"^",9)
+6 SET LRTREAT=$SELECT(LRSERV]"":$PIECE(^DIC(45.7,LRSERV,0),"^",1),1:"UNK")
+7 SET LRDOC=$PIECE(LRX,"^",8)
SET LRPHY=LRDOC
+8 if LRDOC]""
SET LRDOC=$PIECE($GET(^VA(200,+LRDOC,0)),U)
+9 if LRDOC=""
SET LRDOC="UNKNOWN"
+10 SET LRACN1=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
+11 SET LRSN=$PIECE(LRACN1,U,5)
+12 SET LRODT1=$PIECE(LRACN1,U,4)
+13 if LRPHY]""
SET LRBEEP=$GET(^VA(200,LRPHY,.13))
+14 if $GET(LRBEEP)
SET LRBEEP=$PIECE(LRBEEP,U,8)
+15 SET LRSPEC=0
+16 SET LRSPEC=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC))
if LRSPEC'>0
QUIT
Begin DoDot:1
+17 SET LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC,0)
+18 SET LRSP=$PIECE(^LAB(62,$PIECE(LRX,U,2),0),"^",1)
+19 SET LRSI=$PIECE(^LAB(61,+LRX,0),"^",2)
End DoDot:1
+20 SET LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,3)
+21 SET LRDC=$PIECE(LRX,"^",1)
+22 SET LRTC=$PIECE(LRDC,".",2)
+23 SET LRSPEC=LRSP
+24 QUIT
EDIT ;
+1 ; SAVE BUG. Ab(s) saved in LRD0
+2 ; \/
+3 SET LRB0=$PIECE(^LAB(61.2,+^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,0),0),U)
+4 KILL DIR
+5 SET DIR(0)="E"
+6 SET LRPIC=0
+7 ;
+8 ;default to time honored editor
DO VERIFY^LAMIVTL4
+9 ;
+10 SET LRPIC=$ORDER(^LR(LRDFN,LRSUB,LRIDT,3,LRPIC))
if LRPIC'>0!('OK)
QUIT
Begin DoDot:1
+11 SET LRBUG=$PIECE(^LAB(61.2,+^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,0),0),U)
+12 ;don't do Ab(s) they change with new org
IF LRBUG'=LRB0
DO CHORG
QUIT
+13 SET LRRX=1
+14 FOR
SET LRRX=$ORDER(^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,LRRX))
if +LRRX'>0
QUIT
Begin DoDot:2
+15 SET LRNTRP=^LR(LRDFN,LRSUB,LRIDT,3,LRPIC,LRRX)
+16 SET LRDRUG=$PIECE(^LAB(62.06,$ORDER(^LAB(62.06,"AD",LRRX,0)),0),U)
+17 WRITE !,$EXTRACT(LRDRUG,1,30),?32,$PIECE(LRNTRP,U),?38,$PIECE(LRNTRP,U,2)
+18 IF $GET(LRD0(LRRX))'=LRNTRP
DO CHAB
End DoDot:2
End DoDot:1
+19 QUIT
CHORG ;
+1 ;Organism has changed..lets track it.
+2 KILL DIE,DR,DA
+3 SET DIE="^LR(LRDFN,LRSUB,"
+4 SET DA=LRIDT
+5 SET DA(1)=LRDFN
SET DR=.99_"////"_LRB0_"Was changed to "_LRBUG_" BY "_DUZ_" ON "_DT
+6 DO ^DIE
+7 QUIT
CHAB ;
+1 KILL DIE,DR,DA
+2 SET DIE="^LR(LRDFN,LRSUB,"
+3 SET DA=LRIDT
+4 SET DA(1)=LRDFN
SET DR=99_"///"_LRDRUG_"Was changed to "_LRBUG_" BY "_DUZ_" ON "_DT
+5 DO ^DIE
+6 QUIT
RECORD ;
+1 SET LRTIC=LRTIC_":"
+2 SET LRTIC=$PIECE(LRCN,LRTIC,2)
+3 SET LRTIC=$PIECE(LRTIC,";")
+4 SET LRTAC=$PIECE(LRCN,U)
+5 if $DATA(LRTIC)
SET LRECORD=LRECORD_LRTAC_@LRTIC_"|"
+6 QUIT
