LABTST.m

LABTST ; IHS/DIR/FJE - NEW PROGRAM ;

 ;;5.2;LA;;NOV 01, 1997

 S APCVIEN=76908

 D ^APCLIST("V MICROBIOLOGY","","","AD","",APCVIEN,APCVIEN,".01,.04,.05,.07,1208,F60:.01~""0"":.01,F61.2:.04~""0"":.01,F62.06:.05~""0"":.01")

 D LIST

 Q

 ;

LIST ; Lists the ^UTILITY($J)

 S LABGLO="^UTILITY(""LIST"","_$J_")",LABGLN=$L(LABGLO),LABGL=LABGLO,LABGCMP=$S($E(LABGLO,LABGLN)=")":$E(LABGLO,1,LABGLN-1)_",",1:LABGLO)

 F  S LABGL=$Q(@LABGL) Q:$E(LABGL,1,LABGLN)'=LABGCMP  W !,LABGL,"=",@LABGL

 Q

LABTST    ; IHS/DIR/FJE - NEW PROGRAM ;

 +1       ;;5.2;LA;;NOV 01, 1997

 +2        SET APCVIEN=76908

 +3        DO ^APCLIST("V MICROBIOLOGY","","","AD","",APCVIEN,APCVIEN,".01,.04,.05,.07,1208,F60:.01~""0"":.01,F61.2:.04~""0"":.01,F62.06:.05~""0"":.01")

 +4        DO LIST

 +5        QUIT 

 +6       ;

LIST      ; Lists the ^UTILITY($J)

 +1        SET LABGLO="^UTILITY(""LIST"","_$JOB_")"

           SET LABGLN=$LENGTH(LABGLO)

           SET LABGL=LABGLO

           SET LABGCMP=$SELECT($EXTRACT(LABGLO,LABGLN)=")":$EXTRACT(LABGLO,1,LABGLN-1)_",",1:LABGLO)

 +2        FOR 

               SET LABGL=$QUERY(@LABGL)

               IF $EXTRACT(LABGL,1,LABGLN)'=LABGCMP

                   QUIT 

               WRITE !,LABGL,"=",@LABGL

 +3        QUIT