LAHWATCH ;DALOI/JMC - WATCH DATA IN ^LAH GLOBAL ;Sep 12, 2008
;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
;
;
IN ;
N %,LREND,LRWL,LREF,LRINST,LPREF,LRMSK,LRHDR,LRNUM,LRNOP,X,Y
S U="^"
W !!!,"This routine will allow you to look at the verifiable data in the ^LAH GLOBAL ",!,"for a specific instrument",!!
S LREND=0
F D FIND Q:LREND
;
Q
;
;
FIND ;
N DIC
S DIC="^LRO(68.2,",DIC(0)="AEMQ" D ^DIC
I Y<1 S LREND=1 Q
S LRWL=+Y,LRINST=$P(Y,"^",2)
I '$O(^LAH(LRWL,1,0)) W !!?5,"No data for ",LRINST,!! Q
;
;
EN S LREF="^LAH("_LRWL_")",LRMSK=$$GLBR^LRAFUNC(LREF),LRHDR=1
;
;*** Query user for Listing Format ***
;*** Add logic so user can see either ^LAH listing or the interpreted values ***
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="SO^1:Non interpreted LAH global;2:Interpreted values",DIR("A")="Select a Listing Format"
D ^DIR
I $D(DIRUT) S LREND=1 Q
I Y=1 D STRT1 Q
I Y=2 D STRT2 Q
;
Q
;
;
STRT1 ;
I 'LRWL W !!,?10,"No load/worklist defined for this instrument ",!!,$C(7) Q
W !!,"I am about to display the data in ^LAH(",LRWL,")",!,?10,"You may exit at any time by entering the ""^""." H 2
;
D CHK
I $G(LRNOP) Q
;
ALOOP ;
N DIR,DIRUT,DTOUT,DUOUT,LREND,X,Y
W @IOF S LREND=0
F S LPREF=$S('(LREF[""""):LREF,1:LPREF),LREF=$Q(@(LREF)) Q:'($E(LREF,1,$L(LRMSK))=LRMSK)!(LREF="")!(LREND) D
. W !,LREF," = ",@LREF
. I $Y>21 S DIR(0)="E",LRHDR=1 D ^DIR S LREND=$D(DUOUT) Q:LREND W @IOF
;
Q
;
;
STRT2 ;*** Logic to list interpreted ^LAH data ***
;
D CHK
I $G(LRNOP) Q
;
BLOOP ;
N DIR,DIRUT,DTOUT,DUOUT,LREND,X,Y
W @IOF
S LREND=0
F S LPREF=$S('(LREF[""""):LREF,1:LPREF),LREF=$Q(@(LREF)) Q:'($E(LREF,1,$L(LRMSK))=LRMSK)!(LREF="")!(LREND)!($P($P(LREF,"(",2),",",3)="B") D
. I +$P($P(LREF,"(",2),",",4)=0 W !!?5,"Accession # ",$P(@(LREF),U,5)
. I LRHDR=1 W !,"Test",?25,"Value" S LRHDR=0
. I $P($P($P(LREF,"(",2),",",6),")",1)=0 D
. . W !?5,"Organism: ",$P($G(^LAB(61.2,+@LREF,0)),U)
. . I '$D(^LAB(61.2,+@LREF,0)) W !,"***Organism entry points to missing entry # ",+@LREF," in file 61.2 (ETIOLOGY)***"
. I +$P($P(LREF,"(",2),",",6)>0 S LRNUM=+$P($Q(^LAB(62.06,"AD",+$P($P(LREF,"(",2),",",6))),",",4) I $D(^LAB(62.06,LRNUM,0)) W !,$P(^(0),"^"),?25,@LREF
. I +$P($P(LREF,"(",2),",",4)>0,$P($P(LREF,"(",2),",",4)[")",$D(^DD(63.04,+$P($P(LREF,"(",2),",",4),0)) W !,$P(^DD(63.04,+$P($P(LREF,"(",2),",",4),0),"^"),?25,+@LREF
. I $Y>21 S DIR(0)="E",LRHDR=1 D ^DIR S LREND=$D(DUOUT) Q:LREND W @IOF Q
;
Q
;
;
CHK ;
I '$G(LRWL) W !!!,?20,"This instrument has no pointer to ^LAH!",!!! S LRNOP=1 Q
I '$D(^LAH(LRWL)) W !!!,?20,"No data in ^LAH for this instrument!",!!! S LRNOP=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAHWATCH 2728 printed Apr 09, 2024@20:48:46 Page 2
LAHWATCH ;DALOI/JMC - WATCH DATA IN ^LAH GLOBAL ;Sep 12, 2008
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
+2 ;
+3 ;
IN ;
+1 NEW %,LREND,LRWL,LREF,LRINST,LPREF,LRMSK,LRHDR,LRNUM,LRNOP,X,Y
+2 SET U="^"
+3 WRITE !!!,"This routine will allow you to look at the verifiable data in the ^LAH GLOBAL ",!,"for a specific instrument",!!
+4 SET LREND=0
+5 FOR
DO FIND
if LREND
QUIT
+6 ;
+7 QUIT
+8 ;
+9 ;
FIND ;
+1 NEW DIC
+2 SET DIC="^LRO(68.2,"
SET DIC(0)="AEMQ"
DO ^DIC
+3 IF Y<1
SET LREND=1
QUIT
+4 SET LRWL=+Y
SET LRINST=$PIECE(Y,"^",2)
+5 IF '$ORDER(^LAH(LRWL,1,0))
WRITE !!?5,"No data for ",LRINST,!!
QUIT
+6 ;
+7 ;
EN SET LREF="^LAH("_LRWL_")"
SET LRMSK=$$GLBR^LRAFUNC(LREF)
SET LRHDR=1
+1 ;
+2 ;*** Query user for Listing Format ***
+3 ;*** Add logic so user can see either ^LAH listing or the interpreted values ***
+4 ;
+5 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DIR(0)="SO^1:Non interpreted LAH global;2:Interpreted values"
SET DIR("A")="Select a Listing Format"
+7 DO ^DIR
+8 IF $DATA(DIRUT)
SET LREND=1
QUIT
+9 IF Y=1
DO STRT1
QUIT
+10 IF Y=2
DO STRT2
QUIT
+11 ;
+12 QUIT
+13 ;
+14 ;
STRT1 ;
+1 IF 'LRWL
WRITE !!,?10,"No load/worklist defined for this instrument ",!!,$CHAR(7)
QUIT
+2 WRITE !!,"I am about to display the data in ^LAH(",LRWL,")",!,?10,"You may exit at any time by entering the ""^""."
HANG 2
+3 ;
+4 DO CHK
+5 IF $GET(LRNOP)
QUIT
+6 ;
ALOOP ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,LREND,X,Y
+2 WRITE @IOF
SET LREND=0
+3 FOR
SET LPREF=$SELECT('(LREF[""""):LREF,1:LPREF)
SET LREF=$QUERY(@(LREF))
if '($EXTRACT(LREF,1,$LENGTH(LRMSK))=LRMSK)!(LREF="")!(LREND)
QUIT
Begin DoDot:1
+4 WRITE !,LREF," = ",@LREF
+5 IF $Y>21
SET DIR(0)="E"
SET LRHDR=1
DO ^DIR
SET LREND=$DATA(DUOUT)
if LREND
QUIT
WRITE @IOF
End DoDot:1
+6 ;
+7 QUIT
+8 ;
+9 ;
STRT2 ;*** Logic to list interpreted ^LAH data ***
+1 ;
+2 DO CHK
+3 IF $GET(LRNOP)
QUIT
+4 ;
BLOOP ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,LREND,X,Y
+2 WRITE @IOF
+3 SET LREND=0
+4 FOR
SET LPREF=$SELECT('(LREF[""""):LREF,1:LPREF)
SET LREF=$QUERY(@(LREF))
if '($EXTRACT(LREF,1,$LENGTH(LRMSK))=LRMSK)!(LREF="")!(LREND)!($PIECE($PIECE(LREF,"(",2),",",3)="B")
QUIT
Begin DoDot:1
+5 IF +$PIECE($PIECE(LREF,"(",2),",",4)=0
WRITE !!?5,"Accession # ",$PIECE(@(LREF),U,5)
+6 IF LRHDR=1
WRITE !,"Test",?25,"Value"
SET LRHDR=0
+7 IF $PIECE($PIECE($PIECE(LREF,"(",2),",",6),")",1)=0
Begin DoDot:2
+8 WRITE !?5,"Organism: ",$PIECE($GET(^LAB(61.2,+@LREF,0)),U)
+9 IF '$DATA(^LAB(61.2,+@LREF,0))
WRITE !,"***Organism entry points to missing entry # ",+@LREF," in file 61.2 (ETIOLOGY)***"
End DoDot:2
+10 IF +$PIECE($PIECE(LREF,"(",2),",",6)>0
SET LRNUM=+$PIECE($QUERY(^LAB(62.06,"AD",+$PIECE($PIECE(LREF,"(",2),",",6))),",",4)
IF $DATA(^LAB(62.06,LRNUM,0))
WRITE !,$PIECE(^(0),"^"),?25,@LREF
+11 IF +$PIECE($PIECE(LREF,"(",2),",",4)>0
IF $PIECE($PIECE(LREF,"(",2),",",4)[")"
IF $DATA(^DD(63.04,+$PIECE($PIECE(LREF,"(",2),",",4),0))
WRITE !,$PIECE(^DD(63.04,+$PIECE($PIECE(LREF,"(",2),",",4),0),"^"),?25,+@LREF
+12 IF $Y>21
SET DIR(0)="E"
SET LRHDR=1
DO ^DIR
SET LREND=$DATA(DUOUT)
if LREND
QUIT
WRITE @IOF
QUIT
End DoDot:1
+13 ;
+14 QUIT
+15 ;
+16 ;
CHK ;
+1 IF '$GET(LRWL)
WRITE !!!,?20,"This instrument has no pointer to ^LAH!",!!!
SET LRNOP=1
QUIT
+2 IF '$DATA(^LAH(LRWL))
WRITE !!!,?20,"No data in ^LAH for this instrument!",!!!
SET LRNOP=1
QUIT
+3 QUIT
