LAMSBLD.m

LAMSBLD ; IHS/DIR/FJE - BUILD MICROSCAN MIC X-REF IN FILE 62.06 7/20/90 09:48 ;

 ;;5.2;LA;;NOV 01, 1997

 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994

B W "ENTER DATA FOR (A)PI, (M)ICROSCAN, OR (V)ITEK ? " R INST:DTIME W ! Q:((INST="^")!(INST=""))

 S INST=$E(INST,1) S:"AMV"'[INST INST="?"

 I INST="?" W !,"ENTER THE LETTER IN PARENS FOR INSTRUMENT YOU WANT TO LOAD DRUG INFORMATION ON.",! G B

A S U="^",ZZ=0 F AS=0:0 S AS=$O(^LAB(62.06,AS)) Q:AS'>0  D SUS Q:((%<0)&(ZZ=1))

 W !,"DONE" Q

SUS S:'$D(^LAB(62.06,AS,1,0)) ^(0)="^62.061^^"

 S %=2 W !,"Want to load MicroScan MIC values for ",$P(^LAB(62.06,AS,0),U) D YN^DICN Q:(%=2!(%<0))

 I %=0 W !,"ANSWER EITHER 'NO' DO NOT LOAD THIS DRUG OR 'YES' TO LOAD." G SUS

 S DA(1)=AS

 I INST="A" F XX="0","0.01","0.03","0.06","0.12","0.25","0.5",1,2,4,6,8,16,32,64,128,256,512,1024,1280 S ZZ=0 W "." D LOAD Q:ZZ

 I INST="M" F XX="0.03","0.06","0.12","0.25","0.5",1,2,4,6,8,16,32,64,128,256 S ZZ=0 W "." D LOAD Q:ZZ

 I INST="V" F XX="0.06","0.125","0.25","0.5",1,2,4,8,16,20,32,40,64,80,128,160,256,320,500,512,640,1024,1280,2000,2560,5120,10240,20480 S ZZ=0 W "." D LOAD Q:ZZ

 K DLAYGO

 Q

LOAD ;

 S DIC(0)="MLQE",DLAYGO=62.06,DIC="^LAB(62.06,"_AS_",1,",X=XX D FILE Q:ZZ  S X="<"_XX D FILE Q:ZZ  S X=">"_XX D FILE Q

FILE I $D(^LAB(62.06,AS,1,"B",X)) S Y=$O(^(X,0)) G DEF ;Already there!

 D FILE^DICN ;MAKE A NEW ONE

DEF S DR=".01;1//"_X,DA=+Y,(DIK,DIE)=DIC D ^DIE S:$D(Y) ZZ=1 S (DIK,DIE)=DIC D IX1^DIK Q

LAMSBLD   ; IHS/DIR/FJE - BUILD MICROSCAN MIC X-REF IN FILE 62.06 7/20/90 09:48 ;

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

 +2       ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994

B          WRITE "ENTER DATA FOR (A)PI, (M)ICROSCAN, OR (V)ITEK ? "

           READ INST:DTIME

           WRITE !

           IF ((INST="^")!(INST=""))

               QUIT 

 +1        SET INST=$EXTRACT(INST,1)

           IF "AMV"'[INST

               SET INST="?"

 +2        IF INST="?"

               WRITE !,"ENTER THE LETTER IN PARENS FOR INSTRUMENT YOU WANT TO LOAD DRUG INFORMATION ON.",!

               GOTO B

A          SET U="^"

           SET ZZ=0

           FOR AS=0:0

               SET AS=$ORDER(^LAB(62.06,AS))

               IF AS'>0

                   QUIT 

               DO SUS

               IF ((%<0)&(ZZ=1))

                   QUIT 

 +1        WRITE !,"DONE"

           QUIT 

SUS        IF '$DATA(^LAB(62.06,AS,1,0))

               SET ^(0)="^62.061^^"

 +1        SET %=2

           WRITE !,"Want to load MicroScan MIC values for ",$PIECE(^LAB(62.06,AS,0),U)

           DO YN^DICN

           IF (%=2!(%<0))

               QUIT 

 +2        IF %=0

               WRITE !,"ANSWER EITHER 'NO' DO NOT LOAD THIS DRUG OR 'YES' TO LOAD."

               GOTO SUS

 +3        SET DA(1)=AS

 +4        IF INST="A"

               FOR XX="0","0.01","0.03","0.06","0.12","0.25","0.5",1,2,4,6,8,16,32,64,128,256,512,1024,1280

                   SET ZZ=0

                   WRITE "."

                   DO LOAD

                   IF ZZ

                       QUIT 

 +5        IF INST="M"

               FOR XX="0.03","0.06","0.12","0.25","0.5",1,2,4,6,8,16,32,64,128,256

                   SET ZZ=0

                   WRITE "."

                   DO LOAD

                   IF ZZ

                       QUIT 

 +6        IF INST="V"

               FOR XX="0.06","0.125","0.25","0.5",1,2,4,8,16,20,32,40,64,80,128,160,256,320,500,512,640,1024,1280,2000,2560,5120,10240,20480

                   SET ZZ=0

                   WRITE "."

                   DO LOAD

                   IF ZZ

                       QUIT 

 +7        KILL DLAYGO

 +8        QUIT 

LOAD      ;

 +1        SET DIC(0)="MLQE"

           SET DLAYGO=62.06

           SET DIC="^LAB(62.06,"_AS_",1,"

           SET X=XX

           DO FILE

           IF ZZ

               QUIT 

           SET X="<"_XX

           DO FILE

           IF ZZ

               QUIT 

           SET X=">"_XX

           DO FILE

           QUIT 

FILE      ;Already there!

           IF $DATA(^LAB(62.06,AS,1,"B",X))

               SET Y=$ORDER(^(X,0))

               GOTO DEF

 +1       ;MAKE A NEW ONE

           DO FILE^DICN

DEF        SET DR=".01;1//"_X

           SET DA=+Y

           SET (DIK,DIE)=DIC

           DO ^DIE

           IF $DATA(Y)

               SET ZZ=1

           SET (DIK,DIE)=DIC

           DO IX1^DIK

           QUIT