LAHWATCH ; IHS/DIR/FJE - WATCH DATA IN ^LAH GLOBAL 12:41 ; [ 1/13/92 ]
;;5.2;LA;;NOV 01, 1997
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
IN ;
S U="^" W !!!,"This routine will allow you to look at the verifiable data in the ^LAH GLOBAL ",!,"for a specific instrument",!!
FIND K DIC S DIC="^LAB(62.4,",DIC(0)="AEMQ",DIC("S")="I Y<100" D ^DIC G END:Y<1 S LRTSK=+Y,LRINST=$P(Y,"^",2),LRWL=+$P(^LAB(62.4,+Y,0),U,4)
I 'LRWL W !!,?10,"No load/worklist defined for this instrument ",!!,$C(7) G IN
I '$O(^LAH(LRWL,1,0)) W !!?5,"No data for ",LRINST,!! G IN
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 ***
;
K DIR S DIR(0)="SO^1:Non interpreted LAH global;2:Interpreted values",DIR("A")="Select a Listing Format"
D ^DIR K DIR Q:$D(DIRUT)
I X=1 G STRT1
I X=2 G STRT2
D END G IN
;
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
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:X=2
ALOOP ;
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) W !,LREF," = ",@LREF D
. I $Y>21 S DIR(0)="E",LRHDR=1 D ^DIR S LREND=$D(DUOUT) Q:LREND W @IOF
AQUIT ;
W !,"Would you like to see if any more data has entered ^LAH(",LRWL,")" S %=2 D YN^DICN G:%=2!(%=-1) NEXT I %=1 S LREF=LPREF G ALOOP
NEXT ;
W !,"Would you like to view another instruments ^LAH data" S %=2 D YN^DICN G:%=2!(%=-1) END I %=1 D END G FIND
END K X,LRWL,LREF,LRINST,LRTSK,LREND,LPREF,%,Y,LRMSK,DIR,DUOUT,LRHDR,LRNUM,LRNOP
Q
;
STRT2 ;*** Logic to list interpreted ^LAH data ***
D CHK I $G(LRNOP) D END G FIND
BLOOP ;
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 W !?5,"Organism: ",$P($G(^LAB(61.2,+@LREF,0)),U) D
. . 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
BQUIT ;
W !,"Would you like to see if any more data has entered ^LAH(",LRWL,")" S %=2 D YN^DICN G:%=2!(%=-1) NEXT I %=1 S LREF=LPREF G BLOOP
D END G IN
LAHWATCH ; IHS/DIR/FJE - WATCH DATA IN ^LAH GLOBAL 12:41 ; [ 1/13/92 ]
+1 ;;5.2;LA;;NOV 01, 1997
+2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
IN ;
+1 SET U="^"
WRITE !!!,"This routine will allow you to look at the verifiable data in the ^LAH GLOBAL ",!,"for a specific instrument",!!
FIND KILL DIC
SET DIC="^LAB(62.4,"
SET DIC(0)="AEMQ"
SET DIC("S")="I Y<100"
DO ^DIC
IF Y<1
GOTO END
SET LRTSK=+Y
SET LRINST=$PIECE(Y,"^",2)
SET LRWL=+$PIECE(^LAB(62.4,+Y,0),U,4)
+1 IF 'LRWL
WRITE !!,?10,"No load/worklist defined for this instrument ",!!,$CHAR(7)
GOTO IN
+2 IF '$ORDER(^LAH(LRWL,1,0))
WRITE !!?5,"No data for ",LRINST,!!
GOTO IN
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 KILL DIR
SET DIR(0)="SO^1:Non interpreted LAH global;2:Interpreted values"
SET DIR("A")="Select a Listing Format"
+6 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
+7 IF X=1
GOTO STRT1
+8 IF X=2
GOTO STRT2
+9 DO END
GOTO IN
+10 ;
STRT1 IF 'LRWL
WRITE !!,?10,"No load/worklist defined for this instrument ",!!,$CHAR(7)
QUIT
+1 WRITE !!,"I am about to display the data in ^LAH(",LRWL,")",!,?10,"You may exit at any time by entering the ""^""."
HANG 2
CHK IF '$GET(LRWL)
WRITE !!!,?20,"This instrument has no pointer to ^LAH!",!!!
SET LRNOP=1
QUIT
+1 IF '$DATA(^LAH(LRWL))
WRITE !!!,?20,"No data in ^LAH for this instrument!",!!!
SET LRNOP=1
QUIT
+2 IF X=2
QUIT
ALOOP ;
+1 WRITE @IOF
SET LREND=0
FOR
SET LPREF=$SELECT('(LREF[""""):LREF,1:LPREF)
SET LREF=$QUERY(@(LREF))
IF '($EXTRACT(LREF,1,$LENGTH(LRMSK))=LRMSK)!(LREF="")!(LREND)
QUIT
WRITE !,LREF," = ",@LREF
Begin DoDot:1
+2 IF $Y>21
SET DIR(0)="E"
SET LRHDR=1
DO ^DIR
SET LREND=$DATA(DUOUT)
IF LREND
QUIT
WRITE @IOF
End DoDot:1
AQUIT ;
+1 WRITE !,"Would you like to see if any more data has entered ^LAH(",LRWL,")"
SET %=2
DO YN^DICN
IF %=2!(%=-1)
GOTO NEXT
IF %=1
SET LREF=LPREF
GOTO ALOOP
NEXT ;
+1 WRITE !,"Would you like to view another instruments ^LAH data"
SET %=2
DO YN^DICN
IF %=2!(%=-1)
GOTO END
IF %=1
DO END
GOTO FIND
END KILL X,LRWL,LREF,LRINST,LRTSK,LREND,LPREF,%,Y,LRMSK,DIR,DUOUT,LRHDR,LRNUM,LRNOP
+1 QUIT
+2 ;
STRT2 ;*** Logic to list interpreted ^LAH data ***
+1 DO CHK
IF $GET(LRNOP)
DO END
GOTO FIND
BLOOP ;
+1 WRITE @IOF
SET LREND=0
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
+2 IF +$PIECE($PIECE(LREF,"(",2),",",4)=0
WRITE !!?5,"Accession # ",$PIECE(@(LREF),U,5)
+3 IF LRHDR=1
WRITE !,"Test",?25,"Value"
SET LRHDR=0
+4 IF $PIECE($PIECE($PIECE(LREF,"(",2),",",6),")",1)=0
WRITE !?5,"Organism: ",$PIECE($GET(^LAB(61.2,+@LREF,0)),U)
Begin DoDot:2
+5 IF '$DATA(^LAB(61.2,+@LREF,0))
WRITE !,"***Organism entry points to missing entry # ",+@LREF," in file 61.2 (ETIOLOGY)***"
End DoDot:2
+6 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
+7 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
+8 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
BQUIT ;
+1 WRITE !,"Would you like to see if any more data has entered ^LAH(",LRWL,")"
SET %=2
DO YN^DICN
IF %=2!(%=-1)
GOTO NEXT
IF %=1
SET LREF=LPREF
GOTO BLOOP
+2 DO END
GOTO IN
