LAHWATCH.m

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 ---LAHWATCH   2728     printed  Feb 18, 2025@23:09:08                                                                                                                                                                                                    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