Routine: LAMICRA

LAMICRA ; IHS/DIR/FJE - VITEK AUTOINSTRUMENT LOAD OF SPECIAL CHARACTERS. 7/20/90 09:36 ;

 ;;5.2;LA;;NOV 01, 1997

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

 W @$S($D(IOF):IOF,1:"#"),?5,"THIS ROUTINE ADDS DRUG CODES TO VITEK AUTOINSTRUMENT ENTRIES THAT"

 W !,"COULD NOT BE ADDED THRU FILEMAN OR YOU WANT TO CHANGE.",!,?30,"NOTE",!,"THE DRUG MUST ALREADY HAVE BEEN ADDED TO FILE",!

 W "ALL DRUG ENTRIES FOR A CARD TYPE WILL BE PROMPTED.",!,"IF YOU ENTER AN '^' YOU WILL BE ASKED IF YOU WANT TO EXIT."

 W !?5,"ANSWER YES AND THE PROGRAM STOPS PROMPTING DRUGS FOR THAT CARD.",!?5,"ANSWER NO AND THE '^' WILL BE ADDED AS THE CODE FOR THAT DRUG.",!?5,"TAKE NOTE THAT A PRINTOUT OF THE DRUG CODES WILL NOT SHOW THE '^' CODE.",!

START S DIC="^LAB(62.4,",DIC(0)="AEMQZL",DLAYGO=62.4 D ^DIC G:+Y<1 QUIT S LAINST=+Y

 S DIC=DIC_LAINST_",7," D ^DIC I +Y<1 W "NOT VALID CARD TYPE TRY AGAIN.",! K DLAYGO G START

 S LACARD=+Y,LACARDC=Y(0,0),LACARDN=$P(Y(0),"^",2)

 S N=0,%=2 F I=0:0 S N=$O(^LAB(62.4,LAINST,7,LACARD,2,N)) Q:+N<1  D BLNK Q:%<2

 G START

BLNK S LACODEO=$P(^LAB(62.4,LAINST,7,LACARD,2,N,0),"^",4),LADRUG=$P(^LAB(62.06,+^(0),0),"^",1)

 S:LACODEO="" LACODEO=$S($D(^LAB(62.4,LAINST,7,LACARD,2,"C","^")):"^",1:"")

 W !,"CARD TYPE "_LACARDC_"  "_LACARDN_" AND DRUG ",LADRUG," HAS CODE ",LACODEO,"//" R LACODE:DTIME

 W ! I '$T!(LACODE="") W "OK, NOTHING ADDED OR CHANGED.",! Q

B2 I LACODE="^" W $C(7),?10,"DO YOU WANT TO EXIT" S %=2 D YN^DICN W ! Q:%=1  Q:%=-1

 I %=0 W "ENTER YES TO STOP CHECKING DRUGS. NO TO CONTINUE AND ADD '^' AS A VALID CODE.",! G B2

 I LACODEO]"" K ^LAB(62.4,LAINST,7,LACARD,2,"C",LACODEO) W "OLD CODE ",LACODEO," DELETED FROM CROSS REFERENCE.",!

 S $P(^LAB(62.4,LAINST,7,LACARD,2,N,0),"^",4)=$S(LACODE="^":"",1:LACODE) W "CODE ",LACODE,$P("^ NOT","^",LACODE="^"+1)," STORED IN GLOBAL NODE.",!

 S ^LAB(62.4,LAINST,7,LACARD,2,"C",LACODE,N)=""

 W "CODE ",LACODE," ADDED TO CROSS REFERENCE.",! Q

QUIT K I,N,LACODE,LACODEO,LAINST,DLAYGO,LACARD,LACARDC,Y,LACARDN,LADRUG,% Q

LAMICRA   ; IHS/DIR/FJE - VITEK AUTOINSTRUMENT LOAD OF SPECIAL CHARACTERS. 7/20/90 09:36 ;

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

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

 +3        WRITE @$SELECT($DATA(IOF):IOF,1:"#"),?5,"THIS ROUTINE ADDS DRUG CODES TO VITEK AUTOINSTRUMENT ENTRIES THAT"

 +4        WRITE !,"COULD NOT BE ADDED THRU FILEMAN OR YOU WANT TO CHANGE.",!,?30,"NOTE",!,"THE DRUG MUST ALREADY HAVE BEEN ADDED TO FILE",!

 +5        WRITE "ALL DRUG ENTRIES FOR A CARD TYPE WILL BE PROMPTED.",!,"IF YOU ENTER AN '^' YOU WILL BE ASKED IF YOU WANT TO EXIT."

 +6        WRITE !?5,"ANSWER YES AND THE PROGRAM STOPS PROMPTING DRUGS FOR THAT CARD.",!?5,"ANSWER NO AND THE '^' WILL BE ADDED AS THE CODE FOR THAT DRUG.",!?5,"TAKE NOTE THAT A PRINTOUT OF THE DRUG CODES WILL NOT SHOW THE '^' CODE.",!

START      SET DIC="^LAB(62.4,"

           SET DIC(0)="AEMQZL"

           SET DLAYGO=62.4

           DO ^DIC

           IF +Y<1

               GOTO QUIT

           SET LAINST=+Y

 +1        SET DIC=DIC_LAINST_",7,"

           DO ^DIC

           IF +Y<1

               WRITE "NOT VALID CARD TYPE TRY AGAIN.",!

               KILL DLAYGO

               GOTO START

 +2        SET LACARD=+Y

           SET LACARDC=Y(0,0)

           SET LACARDN=$PIECE(Y(0),"^",2)

 +3        SET N=0

           SET %=2

           FOR I=0:0

               SET N=$ORDER(^LAB(62.4,LAINST,7,LACARD,2,N))

               IF +N<1

                   QUIT

               DO BLNK

               IF %<2

                   QUIT

 +4        GOTO START

BLNK       SET LACODEO=$PIECE(^LAB(62.4,LAINST,7,LACARD,2,N,0),"^",4)

           SET LADRUG=$PIECE(^LAB(62.06,+^(0),0),"^",1)

 +1        IF LACODEO=""

               SET LACODEO=$SELECT($DATA(^LAB(62.4,LAINST,7,LACARD,2,"C","^")):"^",1:"")

 +2        WRITE !,"CARD TYPE "_LACARDC_"  "_LACARDN_" AND DRUG ",LADRUG," HAS CODE ",LACODEO,"//"

           READ LACODE:DTIME

 +3        WRITE !

           IF '$TEST!(LACODE="")

               WRITE "OK, NOTHING ADDED OR CHANGED.",!

               QUIT

B2         IF LACODE="^"

               WRITE $CHAR(7),?10,"DO YOU WANT TO EXIT"

               SET %=2

               DO YN^DICN

               WRITE !

               IF %=1

                   QUIT

               IF %=-1

                   QUIT

 +1        IF %=0

               WRITE "ENTER YES TO STOP CHECKING DRUGS. NO TO CONTINUE AND ADD '^' AS A VALID CODE.",!

               GOTO B2

 +2        IF LACODEO]""

               KILL ^LAB(62.4,LAINST,7,LACARD,2,"C",LACODEO)

               WRITE "OLD CODE ",LACODEO," DELETED FROM CROSS REFERENCE.",!

 +3        SET $PIECE(^LAB(62.4,LAINST,7,LACARD,2,N,0),"^",4)=$SELECT(LACODE="^":"",1:LACODE)

           WRITE "CODE ",LACODE,$PIECE("^ NOT","^",LACODE="^"+1)," STORED IN GLOBAL NODE.",!

 +4        SET ^LAB(62.4,LAINST,7,LACARD,2,"C",LACODE,N)=""

 +5        WRITE "CODE ",LACODE," ADDED TO CROSS REFERENCE.",!

           QUIT

QUIT       KILL I,N,LACODE,LACODEO,LAINST,DLAYGO,LACARD,LACARDC,Y,LACARDN,LADRUG,%

           QUIT

LAMICRA.m