- 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 Mar 13, 2025@21:08:26 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 ;
