ECXLRED ;ALB/TMD - Add/Edit Lab Results Translation Values ; 8/1/02 10:27am
;;3.0;DSS EXTRACTS;**46**;Dec 22, 1997
;
EN ; Entry point
N X,Y,DA,DR,DIC,DIE,DLAYGO
W @IOF
W "ADD/EDIT LAB RESULTS TRANSLATION TABLE",!!!
I '$O(^ECX(727.7,0)) W "Lab Results Translation file does not exist",!! R X:5 K X Q
W "This option allows the editing of existing entries or the addition of new"
W !,"entries in the LAB RESULTS TRANSLATION file (#727.7). Free text results"
W !,"(non-numeric) are stored in this file with their corresponding translation codes",!!
S QFLG=0 F Q:QFLG D
.S DIC=727.7,DIC(0)="AELNV",DIC("DR")=".01;1",DLAYGO=727.7 D ^DIC I Y<0!$D(DUOUT) S QFLG=1 Q
.I '$P(Y,U,3) S DIE=DIC,DA=+Y,DR=".01;1" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXLRED 739 printed Nov 22, 2024@17:03:11 Page 2
ECXLRED ;ALB/TMD - Add/Edit Lab Results Translation Values ; 8/1/02 10:27am
+1 ;;3.0;DSS EXTRACTS;**46**;Dec 22, 1997
+2 ;
EN ; Entry point
+1 NEW X,Y,DA,DR,DIC,DIE,DLAYGO
+2 WRITE @IOF
+3 WRITE "ADD/EDIT LAB RESULTS TRANSLATION TABLE",!!!
+4 IF '$ORDER(^ECX(727.7,0))
WRITE "Lab Results Translation file does not exist",!!
READ X:5
KILL X
QUIT
+5 WRITE "This option allows the editing of existing entries or the addition of new"
+6 WRITE !,"entries in the LAB RESULTS TRANSLATION file (#727.7). Free text results"
+7 WRITE !,"(non-numeric) are stored in this file with their corresponding translation codes",!!
+8 SET QFLG=0
FOR
if QFLG
QUIT
Begin DoDot:1
+9 SET DIC=727.7
SET DIC(0)="AELNV"
SET DIC("DR")=".01;1"
SET DLAYGO=727.7
DO ^DIC
IF Y<0!$DATA(DUOUT)
SET QFLG=1
QUIT
+10 IF '$PIECE(Y,U,3)
SET DIE=DIC
SET DA=+Y
SET DR=".01;1"
DO ^DIE
End DoDot:1
+11 QUIT
