- LAMICRA ;SLC/DLG - VITEK AUTOINSTRUMENT LOAD OF SPECIAL CHARACTERS. ;7/20/90 09:36 ;
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAMICRA 1983 printed Dec 13, 2024@01:43:12 Page 2
- LAMICRA ;SLC/DLG - VITEK AUTOINSTRUMENT LOAD OF SPECIAL CHARACTERS. ;7/20/90 09:36 ;
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- +2 WRITE @$SELECT($DATA(IOF):IOF,1:"#"),?5,"THIS ROUTINE ADDS DRUG CODES TO VITEK AUTOINSTRUMENT ENTRIES THAT"
- +3 WRITE !,"COULD NOT BE ADDED THRU FILEMAN OR YOU WANT TO CHANGE.",!,?30,"NOTE",!,"THE DRUG MUST ALREADY HAVE BEEN ADDED TO FILE",!
- +4 WRITE "ALL DRUG ENTRIES FOR A CARD TYPE WILL BE PROMPTED.",!,"IF YOU ENTER AN '^' YOU WILL BE ASKED IF YOU WANT TO EXIT."
- +5 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