LAZINTEG.m

LAZINTEG ; INTEGRITY CHECKER FOR LAB AUTOMATED INSTRUMENTS - ISC/SFO ; 17-Nov-1986 10:20 am

 ;;LAB AUTOMATED INSTRUMENTS V3.05V

 W !,"Routine Integrity Check",!,"-----------------------",!

 S FLG=0 D CC F I=1:1 S X=$T(ROU+I),T=$P(X," ",1),U=$P(X,";;",2) Q:X=""  D TEST

 Q

TEST W:'(FLG#8*FLG) ! W ?(FLG#8*10),T S X=T,FLG=FLG+1

ENTEST I $D(^%ZOSF("TEST")) X ^("TEST") I '$T W *7,!?3,"<<",X,">> is not in your directory" S FLG=0 Q

 X "ZL @T F Y=1:1:99 S L=$T(+Y),LN=$L(L) X CC S:'LN Y=99"

 I (U-T) W *7,!?3,"<<",X,">> Routine is off by ",U-T," bit",$E("s",U'?.P1"1") S FLG=0 Q

 Q

CC S CC="F C=1:1:LN S T=$A(L,C)+T" Q

EN ;Entry point to check individual routines

 R !,"Routine: ",R:$S($D(DTIME)#2:DTIME,1:120) Q:'$T!(R="^")!(R="")!(R=".")

 I ($T(@R)']"") W !?3,"<<",R,">> is not in my routine list" G EN

 S X=$T(@R),T=$P(X," ",1),U=$P(X,";",3),X=T

 D CC,ENTEST W:(U=T) "  ...IS OK" G EN

ROU ;;

LAABL3 ;;73583

LAACA ;;88266

LAASTRA ;;66821

LAB ;;99799

LAB1 ;;99890

LABALARM ;;42232

LABINIT ;;32279

LABIOH ;;104271

LABIOU ;;96017

LABMD87P ;;73512

LABTEST ;;142166

LAC178 ;;71047

LACBIO ;;77508

LACFARA ;;72167

LACL5500 ;;63072

LACLNTE ;;66695

LACLNTEK ;;65837

LACLT200 ;;63212

LACOAGX2 ;;106205

LACOLT ;;95853

LACOLT1 ;;98073

LACOLT2 ;;106067

LACOLT24 ;;70947

LACOLT3 ;;85318

LACOLT5 ;;86773

LACOLT6 ;;90859

LACRIT ;;54447

LADACOS ;;67831

LADMND ;;102545

LAE4A ;;100555

LAEKT4 ;;74937

LAEKT7 ;;81592

LAEKT7P ;;66590

LAELT ;;58662

LAELT8D ;;72963

LAEXEC ;;72379

LAGEN ;;137873

LAH1 ;;67539

LAH480 ;;70179

LAH6K ;;64815

LAH705 ;;67055

LAH737 ;;76912

LAHLOG ;;81217

LAHTRK ;;124270

LAIL13 ;;65785

LAIL1312 ;;94650

LAIRIS ;;79385

LAKDA ;;60454

LAKOAG40 ;;78378

LAMIV13 ;;90985

LAMIVTK ;;93625

LAMLA7 ;;60780

LAMODH ;;94280

LAMODU ;;112975

LAMONARK ;;83616

LAMSTAT ;;70893

LAPMAX ;;101819

LAPX ;;87497

LARA1K ;;66336

LAS790 ;;63165

LASET ;;99018

LASMA12 ;;73102

LASMA2 ;;96074

LASMA2C ;;88099

LASMAC4 ;;83945

LASMACA ;;130162

LASP120 ;;71282

LASPEC ;;78543

LASTRA ;;104470

LATDX ;;68978

LATOA ;;65895

LAZINTEG  ; INTEGRITY CHECKER FOR LAB AUTOMATED INSTRUMENTS - ISC/SFO ; 17-Nov-1986 10:20 am

 +1       ;;LAB AUTOMATED INSTRUMENTS V3.05V

 +2        WRITE !,"Routine Integrity Check",!,"-----------------------",!

 +3        SET FLG=0

           DO CC

           FOR I=1:1

               SET X=$TEXT(ROU+I)

               SET T=$PIECE(X," ",1)

               SET U=$PIECE(X,";;",2)

               IF X=""

                   QUIT 

               DO TEST

 +4        QUIT 

TEST       IF '(FLG#8*FLG)

               WRITE !

           WRITE ?(FLG#8*10),T

           SET X=T

           SET FLG=FLG+1

ENTEST     IF $DATA(^%ZOSF("TEST"))

               XECUTE ^("TEST")

               IF '$TEST

                   WRITE *7,!?3,"<<",X,">> is not in your directory"

                   SET FLG=0

                   QUIT 

 +1        XECUTE "ZL @T F Y=1:1:99 S L=$T(+Y),LN=$L(L) X CC S:'LN Y=99"

 +2        IF (U-T)

               WRITE *7,!?3,"<<",X,">> Routine is off by ",U-T," bit",$EXTRACT("s",U'?.P1"1")

               SET FLG=0

               QUIT 

 +3        QUIT 

CC         SET CC="F C=1:1:LN S T=$A(L,C)+T"

           QUIT 

EN        ;Entry point to check individual routines

 +1        READ !,"Routine: ",R:$SELECT($DATA(DTIME)#2:DTIME,1:120)

           IF '$TEST!(R="^")!(R="")!(R=".")

               QUIT 

 +2        IF ($TEXT(@R)']"")

               WRITE !?3,"<<",R,">> is not in my routine list"

               GOTO EN

 +3        SET X=$TEXT(@R)

           SET T=$PIECE(X," ",1)

           SET U=$PIECE(X,";",3)

           SET X=T

 +4        DO CC

           DO ENTEST

           IF (U=T)

               WRITE "  ...IS OK"

           GOTO EN

ROU       ;;

LAABL3    ;;73583

LAACA     ;;88266

LAASTRA   ;;66821

LAB       ;;99799

LAB1      ;;99890

LABALARM  ;;42232

LABINIT   ;;32279

LABIOH    ;;104271

LABIOU    ;;96017

LABMD87P  ;;73512

LABTEST   ;;142166

LAC178    ;;71047

LACBIO    ;;77508

LACFARA   ;;72167

LACL5500  ;;63072

LACLNTE   ;;66695

LACLNTEK  ;;65837

LACLT200  ;;63212

LACOAGX2  ;;106205

LACOLT    ;;95853

LACOLT1   ;;98073

LACOLT2   ;;106067

LACOLT24  ;;70947

LACOLT3   ;;85318

LACOLT5   ;;86773

LACOLT6   ;;90859

LACRIT    ;;54447

LADACOS   ;;67831

LADMND    ;;102545

LAE4A     ;;100555

LAEKT4    ;;74937

LAEKT7    ;;81592

LAEKT7P   ;;66590

LAELT     ;;58662

LAELT8D   ;;72963

LAEXEC    ;;72379

LAGEN     ;;137873

LAH1      ;;67539

LAH480    ;;70179

LAH6K     ;;64815

LAH705    ;;67055

LAH737    ;;76912

LAHLOG    ;;81217

LAHTRK    ;;124270

LAIL13    ;;65785

LAIL1312  ;;94650

LAIRIS    ;;79385

LAKDA     ;;60454

LAKOAG40  ;;78378

LAMIV13   ;;90985

LAMIVTK   ;;93625

LAMLA7    ;;60780

LAMODH    ;;94280

LAMODU    ;;112975

LAMONARK  ;;83616

LAMSTAT   ;;70893

LAPMAX    ;;101819

LAPX      ;;87497

LARA1K    ;;66336

LAS790    ;;63165

LASET     ;;99018

LASMA12   ;;73102

LASMA2    ;;96074

LASMA2C   ;;88099

LASMAC4   ;;83945

LASMACA   ;;130162

LASP120   ;;71282

LASPEC    ;;78543

LASTRA    ;;104470

LATDX     ;;68978

LATOA     ;;65895