LR463ETI ;LEIDOS/TCK - PRE INSTALL ROUTINE FOR LR*5.2*463 ; 4/25/16 10:48am
;;5.2;LAB SERVICE;**463**;NOV 7, 2015;Build 77
;
EN ;
;ADD NEW ENTRIES TO THE ETIOLGY FILE, (#61.2)
N XX,LRFDA,NME,SNMD,ID,GRP,WKLD,ARRAY,IEN,STOP
S (LRFDA,NME,SNMD,ID,GRP,WKLD,XX,IEN)="",STOP=0
;Build array of new Etiolgy names
S ARRAY("CRE",1)="KLEBSIELLA PNEUMONIAE, CARBAPENEM RESISTANT (CRE)"
S ARRAY("CRE",2)="KLEBSIELLA OXYTOCA, CARBAPENEM RESISTANT (CRE)"
S ARRAY("CRE",3)="ESCHERICHIA COLI, CARBAPENEM RESISTANT (CRE)"
S ARRAY("CRE",4)="ENTEROBACTER CLOACAE, CARBAPENEM RESISTANT (CRE)"
S ARRAY("CRE",5)="ENTEROBACTER SPP, CARBAPENEM RESISTANT (CRE)"
;Check if new Etilogy already exists in file 61.2
F S XX=$O(ARRAY("CRE",XX)) Q:XX="" D
.S NME=ARRAY("CRE",XX)
.S NAME=$E(NME,1,30)
.I $D(^LAB(61.2,"B",NAME)) D Q
..S IEN="",IEN=$O(^LAB(61.2,"B",NAME,IEN))
..S ^TMP($J,"ETI","OLD",IEN)=NME
.I '$D(^LAB(61.2,"B",NAME)) D
..D ADD(NME,.IEN)
D DISPLAY
Q
;
ADD(NME,IEN) ;
N LRFIL,LRFDA
S LRFIL=61.2
;Stub new record in 61.2 -- name only
S X=NME,DIC(0)="L",DIC="^LAB(61.2,",LRFMERTS=1
D FILE^DICN S IEN=+Y
;Update NODE 0 FIELDS
K DLAYGO
S LRFIL=61.2,LRIEN=IEN_","
S TMPFDA(1,LRFIL,LRIEN,2)=""
S TMPFDA(1,LRFIL,LRIEN,4)="B"
S TMPFDA(1,LRFIL,LRIEN,1.6)="ENTEROBACTERIACEAE"
D UPDATE^DIE("","TMPFDA(1)","LRIENS","LRMSG")
K LRFIL,LRIEN,TMPFDA
S ^TMP($J,"ETI","NEW",IEN)=NME
Q
;
DISPLAY ;
W !!
I $D(^TMP($J,"ETI")) M ETIARY=^TMP($J,"ETI")
I $D(ETIARY("NEW")) D
.W !,"The following Etiology entries were added to the Etiology file: "
.W !
.S I="" F S I=$O(ETIARY("NEW",I)) Q:I="" D
..S NAME=ETIARY("NEW",I)
..W !,I_" "_NAME
I $D(ETIARY("OLD")) D
.W !,"The following Etiology items were found in the Etiology file: "
.S I="" F S I=$O(ETIARY("OLD",I)) Q:I="" D
..S NAME=ETIARY("OLD",I)
..W !,I_" "_NAME
END ;
K DIC,I,LRFMERTS,LRMULT,N,NAME,WKLIEN,X,Y,ETIARY,^TMP("ETI")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR463ETI 1971 printed Nov 22, 2024@17:14:12 Page 2
LR463ETI ;LEIDOS/TCK - PRE INSTALL ROUTINE FOR LR*5.2*463 ; 4/25/16 10:48am
+1 ;;5.2;LAB SERVICE;**463**;NOV 7, 2015;Build 77
+2 ;
EN ;
+1 ;ADD NEW ENTRIES TO THE ETIOLGY FILE, (#61.2)
+2 NEW XX,LRFDA,NME,SNMD,ID,GRP,WKLD,ARRAY,IEN,STOP
+3 SET (LRFDA,NME,SNMD,ID,GRP,WKLD,XX,IEN)=""
SET STOP=0
+4 ;Build array of new Etiolgy names
+5 SET ARRAY("CRE",1)="KLEBSIELLA PNEUMONIAE, CARBAPENEM RESISTANT (CRE)"
+6 SET ARRAY("CRE",2)="KLEBSIELLA OXYTOCA, CARBAPENEM RESISTANT (CRE)"
+7 SET ARRAY("CRE",3)="ESCHERICHIA COLI, CARBAPENEM RESISTANT (CRE)"
+8 SET ARRAY("CRE",4)="ENTEROBACTER CLOACAE, CARBAPENEM RESISTANT (CRE)"
+9 SET ARRAY("CRE",5)="ENTEROBACTER SPP, CARBAPENEM RESISTANT (CRE)"
+10 ;Check if new Etilogy already exists in file 61.2
+11 FOR
SET XX=$ORDER(ARRAY("CRE",XX))
if XX=""
QUIT
Begin DoDot:1
+12 SET NME=ARRAY("CRE",XX)
+13 SET NAME=$EXTRACT(NME,1,30)
+14 IF $DATA(^LAB(61.2,"B",NAME))
Begin DoDot:2
+15 SET IEN=""
SET IEN=$ORDER(^LAB(61.2,"B",NAME,IEN))
+16 SET ^TMP($JOB,"ETI","OLD",IEN)=NME
End DoDot:2
QUIT
+17 IF '$DATA(^LAB(61.2,"B",NAME))
Begin DoDot:2
+18 DO ADD(NME,.IEN)
End DoDot:2
End DoDot:1
+19 DO DISPLAY
+20 QUIT
+21 ;
ADD(NME,IEN) ;
+1 NEW LRFIL,LRFDA
+2 SET LRFIL=61.2
+3 ;Stub new record in 61.2 -- name only
+4 SET X=NME
SET DIC(0)="L"
SET DIC="^LAB(61.2,"
SET LRFMERTS=1
+5 DO FILE^DICN
SET IEN=+Y
+6 ;Update NODE 0 FIELDS
+7 KILL DLAYGO
+8 SET LRFIL=61.2
SET LRIEN=IEN_","
+9 SET TMPFDA(1,LRFIL,LRIEN,2)=""
+10 SET TMPFDA(1,LRFIL,LRIEN,4)="B"
+11 SET TMPFDA(1,LRFIL,LRIEN,1.6)="ENTEROBACTERIACEAE"
+12 DO UPDATE^DIE("","TMPFDA(1)","LRIENS","LRMSG")
+13 KILL LRFIL,LRIEN,TMPFDA
+14 SET ^TMP($JOB,"ETI","NEW",IEN)=NME
+15 QUIT
+16 ;
DISPLAY ;
+1 WRITE !!
+2 IF $DATA(^TMP($JOB,"ETI"))
MERGE ETIARY=^TMP($JOB,"ETI")
+3 IF $DATA(ETIARY("NEW"))
Begin DoDot:1
+4 WRITE !,"The following Etiology entries were added to the Etiology file: "
+5 WRITE !
+6 SET I=""
FOR
SET I=$ORDER(ETIARY("NEW",I))
if I=""
QUIT
Begin DoDot:2
+7 SET NAME=ETIARY("NEW",I)
+8 WRITE !,I_" "_NAME
End DoDot:2
End DoDot:1
+9 IF $DATA(ETIARY("OLD"))
Begin DoDot:1
+10 WRITE !,"The following Etiology items were found in the Etiology file: "
+11 SET I=""
FOR
SET I=$ORDER(ETIARY("OLD",I))
if I=""
QUIT
Begin DoDot:2
+12 SET NAME=ETIARY("OLD",I)
+13 WRITE !,I_" "_NAME
End DoDot:2
End DoDot:1
END ;
+1 KILL DIC,I,LRFMERTS,LRMULT,N,NAME,WKLIEN,X,Y,ETIARY,^TMP("ETI")
+2 QUIT
+3 ;
