- 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