BLRF612A ; IHS/OIT/MKK - IHS Lab: File 61.2 Add from DTS Server ; 22-Oct-2013 09:22 ; MKK
;;5.2;LAB SERVICE;**1033**;NOV 1, 1997
;
; Add entries to ETIOLOGY FIELD (#61.2) dictionary using lookup into DTS Server and then guiding
; user to enter data for specific fields so as to use an UPDATE^DIE call to update the dictionary.
;
PEP ; EP
EP ; EP
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
ADDIT ; EP - Add an Entry
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D ^XBCLS
S (BAIL,FOUNDSUM)=0
F Q:FOUNDSUM!(BAIL) D
. W !!
. D ^XBFMK
. S DIR(0)="F"
. S DIR("A")="Enter SNOMED Description (Free Text)"
. D ^DIR
. I +$G(DIRUT) D Q
.. W !,?4,"Quit or No/Invalid Input. Routine Ends."
.. D PRESSKEY^BLRGMENU(9)
.. S BAIL=1
. ;
. S OUT="VARS",IN=$G(X)_"^F^^^^100"
. S FOUNDSUM=$$SEARCH^BSTSAPI(OUT,IN)
. I FOUNDSUM<1 W !!,?9,"No entries found in the IHS STANDARD TERMINOLOGY database. Try Again."
;
Q:BAIL
;
S WHICHONE=0
D EN^BLRSM
I WHICHONE<1 D Q
. W !,?4,"No Entry Selected. Routine Ends."
. D PRESSKEY^BLRGMENU(9)
;
D REST61P2
Q
;
REST61P2 ; EP - Enter rest of data needed to update 61.2
S STR=$G(SNOMED(WHICHONE))
S SNOMED=$P(STR,"^")
S SNOMEDSC=$P(STR,"^",2)
;
Q:$$ALREADY(SNOMED,SNOMEDESC)
;
D CGTRIBEF
D GRAMSTAN
D IDENTIFR
D ABBREV
D SUSEDITT
D HDEPTRPT
;
K ERRS,FDA
S FDA(61.2,"+1,",.01)=SNOMEDSC
S FDA(61.2,"+1,",2)=SNOMED
S:$L(GRAMSTAN) FDA(61.2,"+1,",3)=GRAMSTAN
S:$L(IDENTIFR) FDA(61.2,"+1,",4)=IDENTIFR
S:$L(ABBREV) FDA(61.2,"+1,",6)=ABBREV
S:$L(SUSEDITT) FDA(61.2,"+1,",8)=SUSEDITT
S:$L(HDEPTRPT) FDA(61.2,"+1,",10)=HDEPTRPT
S:$L(CGTRIBEF) FDA(61.2,"+1,",1.6)=CGTRIBEF
;
D UPDATE^DIE("ES","FDA","ERRS")
;
I $D(ERRS) D ERRORS Q
;
D DISPLAY(+$$FIND1^DIC(61.2,,,SNOMEDSC))
;
Q
;
ALREADY(SNOMED,SNOMEDESC) ; EP - Is the selected entry already in 61.2?
NEW ALREADY
;
S ALREADY=$$FIND1^DIC(61.2,,,SNOMEDSC,,,"ERRS")
I ALREADY D
. W !,?4,"SNOMED ",SNOMED," already exists in ETIOLOGY FIELD (#61.2) File. Routine Ends."
. D PRESSKEY^BLRGMENU(9)
Q ALREADY
;
CGTRIBEF ; EP - CLASS/GROUP-TRIBE/FAMILY
D ^XBCLS
S CGTRIBEF=""
D ^XBFMK
S DIR(0)="FO^1:30"
S DIR("A")="CLASS/GROUP-TRIBE/FAMILY"
S DIR("?")="The class/group or tribe/family the etiologic agent belongs to."
D ^DIR
I +$G(DIRUT) D NOSELECT("CLASS/GROUP-TRIBE/FAMILY") Q
;
S CGTRIBEF=$G(X)
Q
;
GRAMSTAN ; EP - GRAM STAIN
D ^XBCLS
S GRAMSTAN=""
;
D ^XBFMK
S DIR(0)="S^1:;2:;3:;4:;"
S DIR("L",1)="Select GRAM STAIN:"
S DIR("L",2)=""
S DIR("L",3)=" 1) GRAM POSITIVE"
S DIR("L",4)=" 2) GRAM NEGATIVE"
S DIR("L",5)=" 3) INDETERMINATE"
S DIR("L",6)=" 4) EXIT/NO SELECTION"
S DIR("L")=""
S DIR("A")="Selection"
D ^DIR
;
I +$G(DIRUT)!(+$G(Y)<1) D NOSELECT("GRAM STAIN") Q
;
S GRAMSTAN=$S(Y=1:"P",Y=2:"N",Y=3:"I",1:"")
Q
;
IDENTIFR ; EP - IDENTIFIER
D ^XBCLS
S IDENTIFR=""
;
D ^XBFMK
S DIR(0)="S^1:;2:;3:;4:;5:;6:;7:;8:;"
S DIR("L",1)="Select category into which the etiologic agent falls:"
S DIR("L",2)=""
S DIR("L",3)=" 1) BACTERIUM"
S DIR("L",4)=" 2) FUNGUS"
S DIR("L",5)=" 3) PARASITE"
S DIR("L",6)=" 4) MYCOBACTERIUM"
S DIR("L",7)=" 5) VIRUS"
S DIR("L",8)=" 6) CHEMICAL"
S DIR("L",9)=" 7) DRUG"
S DIR("L",10)=" 8) EXIT/NO SELECTION"
S DIR("L")=""
S DIR("A")="Selection"
S DIR("?")="This field identifies the category into which this etiologic agent falls."
D ^DIR
;
I +$G(DIRUT)!(+$G(Y)<1) D NOSELECT("IDENTIFIER") Q
;
S IDENTIFR=$S(Y=1:"B",Y=2:"F",Y=3:"P",Y=4:"M",Y=5:"V",Y=6:"C",Y=7:"D",1:"")
Q
;
ABBREV ; EP - ABBREVIATION
D ^XBCLS
S ABBREV=""
D ^XBFMK
S DIR(0)="FO^1:5"
S DIR("A")="ABBREVIATION"
D ^DIR
I +$G(DIRUT) D NOSELECT("CLASS/GROUP-TRIBE/FAMILY") Q
;
S ABBREV=$G(X)
Q
;
SUSEDITT ; EP - SUSCEPTIBILITY EDIT TEMPLATE
NEW ARRAY,CNT,DIRZERO,IEN,INDEX,TMPLNAME
;
D ^XBCLS
S SUSEDITT=""
;
S IEN=0
F S IEN=$O(^DIE(IEN)) Q:IEN<1 D
. I $P($G(^DIE(IEN,0)),"^",4)=63 S ARRAY($P($G(^(0)),"^"))=IEN
;
S DIRZERO="S^"
S CNT=0,TMPLNAME=""
F S TMPLNAME=$O(ARRAY(TMPLNAME)) Q:TMPLNAME="" D
. S CNT=CNT+1
. S DIRZERO=DIRZERO_CNT_":;"
. S DIRZERO(CNT)=$$LJ^XLFSTR($J(CNT,2)_") "_$E(TMPLNAME,1,18),26)
. S INDEX(CNT)=TMPLNAME
;
; Add EXIT/NO SELECTION
S CNT=CNT+1
S DIRZERO=DIRZERO_CNT_":;"
S DIRZERO(CNT)=$$LJ^XLFSTR($J(CNT,2)_") EXIT/NO SELECTION",26)
S INDEX(CNT)=""
;
S CNT=CNT+1
S DIRZERO=DIRZERO_(CNT)_":AL"
;
D ^XBFMK
S DIR(0)=DIRZERO
S DIR("L",1)="Select SUSCEPTIBILITY EDIT TEMPLATE:"
S DIR("L",2)=""
S BELOW=3
S CNT=0
F S CNT=$O(DIRZERO(CNT)) Q:CNT<1 D
. S:(CNT#3)=1 DIR("L",BELOW)=$J("",2)
. S DIR("L",BELOW)=$G(DIR("L",BELOW))_DIRZERO(CNT)
. S:(CNT#3)=0 BELOW=BELOW+1
;
S DIR("L")=""
S DIR("A")="Selection"
S DIR("?")="Contains the edit template name the etiologic agent is associated with."
S DIR("??")="Determines the set of antibiotics that will be shown for editing when this organism is chosen."
D ^DIR
;
I +$G(DIRUT) D NOSELECT("SUSCEPTIBILITY EDIT TEMPLATE") Q
;
S SUSEDITT=$G(INDEX(Y))
Q
;
HDEPTRPT ; EP - HEALTH DEPT REPORT
D ^XBCLS
S HDEPTRPT=""
D ^XBFMK
S DIR(0)="YO"
S DIR("A")="HEALTH DEPARTMENT REPORT"
D ^DIR
I +$G(DIRUT) D NOSELECT("HEALTH DEPARTMENT REPORT") Q
;
S HDEPTRPT=$E(X)
Q
;
DISPLAY(IEN) ; EP - Display the entry in 61.2
S DA=IEN
S DIC="^LAB(61.2,"
D EN^DIQ
D PRESSKEY^BLRGMENU(9)
Q
;
NOSELECT(WOT) ; EP - Selection not done
W !,?4,WOT," not selected."
W !,?9,"None will be added to ETIOLOGY FIELD (#61.2) dictionary."
D PRESSKEY^BLRGMENU(4)
Q
;
ERRORS ; EP - ERRS Array has data. Display it.
W !!,"ERRORS:",!
S J="ERRS"
S X=$G(@J)
W ?4,J,"=",X,!
F S J=$Q(@J) Q:J="" W ?9,J,"=",@J,!
;
D PRESSKEY^BLRGMENU(4)
Q
;
TESTIT ; EP
NEW ERRS,FDA
N SNOMEDSC,SNOMED,GRAMSTAN,IDENTIFR,ABBREV,SUSEDITT,HDEPTRPT,CGTRIBEF
;
S SNOMEDSC="Rubella antibody screening"
S SNOMED=375964015
S GRAMSTAN="P"
S IDENTIFR="B"
S ABBREV="RAS"
S SUSEDITT="GNS"
S HDEPTRPT="Y"
S CGTRIBEF="ENTEB"
;
S FDA(61.2,"+1,",.01)=SNOMEDSC
S FDA(61.2,"+1,",2)=SNOMED
S FDA(61.2,"+1,",3)=GRAMSTAN
S FDA(61.2,"+1,",4)=IDENTIFR
S FDA(61.2,"+1,",6)=ABBREV
S FDA(61.2,"+1,",8)=SUSEDITT
S FDA(61.2,"+1,",10)=HDEPTRPT
S FDA(61.2,"+1,",1.6)=CGTRIBEF
;
D UPDATE^DIE("ES","FDA",,"ERRS")
I $D(ERRS) D ERRORS Q
;
D DISPLAY(+$$FIND1^DIC(61.2,,,SNOMEDSC))
Q
BLRF612A ; IHS/OIT/MKK - IHS Lab: File 61.2 Add from DTS Server ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**1033**;NOV 1, 1997
+2 ;
+3 ; Add entries to ETIOLOGY FIELD (#61.2) dictionary using lookup into DTS Server and then guiding
+4 ; user to enter data for specific fields so as to use an UPDATE^DIE call to update the dictionary.
+5 ;
PEP ; EP
EP ; EP
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
ADDIT ; EP - Add an Entry
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 DO ^XBCLS
+4 SET (BAIL,FOUNDSUM)=0
+5 FOR
IF FOUNDSUM!(BAIL)
QUIT
Begin DoDot:1
+6 WRITE !!
+7 DO ^XBFMK
+8 SET DIR(0)="F"
+9 SET DIR("A")="Enter SNOMED Description (Free Text)"
+10 DO ^DIR
+11 IF +$GET(DIRUT)
Begin DoDot:2
+12 WRITE !,?4,"Quit or No/Invalid Input. Routine Ends."
+13 DO PRESSKEY^BLRGMENU(9)
+14 SET BAIL=1
End DoDot:2
QUIT
+15 ;
+16 SET OUT="VARS"
SET IN=$GET(X)_"^F^^^^100"
+17 SET FOUNDSUM=$$SEARCH^BSTSAPI(OUT,IN)
+18 IF FOUNDSUM<1
WRITE !!,?9,"No entries found in the IHS STANDARD TERMINOLOGY database. Try Again."
End DoDot:1
+19 ;
+20 IF BAIL
QUIT
+21 ;
+22 SET WHICHONE=0
+23 DO EN^BLRSM
+24 IF WHICHONE<1
Begin DoDot:1
+25 WRITE !,?4,"No Entry Selected. Routine Ends."
+26 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT
+27 ;
+28 DO REST61P2
+29 QUIT
+30 ;
REST61P2 ; EP - Enter rest of data needed to update 61.2
+1 SET STR=$GET(SNOMED(WHICHONE))
+2 SET SNOMED=$PIECE(STR,"^")
+3 SET SNOMEDSC=$PIECE(STR,"^",2)
+4 ;
+5 IF $$ALREADY(SNOMED,SNOMEDESC)
QUIT
+6 ;
+7 DO CGTRIBEF
+8 DO GRAMSTAN
+9 DO IDENTIFR
+10 DO ABBREV
+11 DO SUSEDITT
+12 DO HDEPTRPT
+13 ;
+14 KILL ERRS,FDA
+15 SET FDA(61.2,"+1,",.01)=SNOMEDSC
+16 SET FDA(61.2,"+1,",2)=SNOMED
+17 IF $LENGTH(GRAMSTAN)
SET FDA(61.2,"+1,",3)=GRAMSTAN
+18 IF $LENGTH(IDENTIFR)
SET FDA(61.2,"+1,",4)=IDENTIFR
+19 IF $LENGTH(ABBREV)
SET FDA(61.2,"+1,",6)=ABBREV
+20 IF $LENGTH(SUSEDITT)
SET FDA(61.2,"+1,",8)=SUSEDITT
+21 IF $LENGTH(HDEPTRPT)
SET FDA(61.2,"+1,",10)=HDEPTRPT
+22 IF $LENGTH(CGTRIBEF)
SET FDA(61.2,"+1,",1.6)=CGTRIBEF
+23 ;
+24 DO UPDATE^DIE("ES","FDA","ERRS")
+25 ;
+26 IF $DATA(ERRS)
DO ERRORS
QUIT
+27 ;
+28 DO DISPLAY(+$$FIND1^DIC(61.2,,,SNOMEDSC))
+29 ;
+30 QUIT
+31 ;
ALREADY(SNOMED,SNOMEDESC) ; EP - Is the selected entry already in 61.2?
+1 NEW ALREADY
+2 ;
+3 SET ALREADY=$$FIND1^DIC(61.2,,,SNOMEDSC,,,"ERRS")
+4 IF ALREADY
Begin DoDot:1
+5 WRITE !,?4,"SNOMED ",SNOMED," already exists in ETIOLOGY FIELD (#61.2) File. Routine Ends."
+6 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
+7 QUIT ALREADY
+8 ;
CGTRIBEF ; EP - CLASS/GROUP-TRIBE/FAMILY
+1 DO ^XBCLS
+2 SET CGTRIBEF=""
+3 DO ^XBFMK
+4 SET DIR(0)="FO^1:30"
+5 SET DIR("A")="CLASS/GROUP-TRIBE/FAMILY"
+6 SET DIR("?")="The class/group or tribe/family the etiologic agent belongs to."
+7 DO ^DIR
+8 IF +$GET(DIRUT)
DO NOSELECT("CLASS/GROUP-TRIBE/FAMILY")
QUIT
+9 ;
+10 SET CGTRIBEF=$GET(X)
+11 QUIT
+12 ;
GRAMSTAN ; EP - GRAM STAIN
+1 DO ^XBCLS
+2 SET GRAMSTAN=""
+3 ;
+4 DO ^XBFMK
+5 SET DIR(0)="S^1:;2:;3:;4:;"
+6 SET DIR("L",1)="Select GRAM STAIN:"
+7 SET DIR("L",2)=""
+8 SET DIR("L",3)=" 1) GRAM POSITIVE"
+9 SET DIR("L",4)=" 2) GRAM NEGATIVE"
+10 SET DIR("L",5)=" 3) INDETERMINATE"
+11 SET DIR("L",6)=" 4) EXIT/NO SELECTION"
+12 SET DIR("L")=""
+13 SET DIR("A")="Selection"
+14 DO ^DIR
+15 ;
+16 IF +$GET(DIRUT)!(+$GET(Y)<1)
DO NOSELECT("GRAM STAIN")
QUIT
+17 ;
+18 SET GRAMSTAN=$SELECT(Y=1:"P",Y=2:"N",Y=3:"I",1:"")
+19 QUIT
+20 ;
IDENTIFR ; EP - IDENTIFIER
+1 DO ^XBCLS
+2 SET IDENTIFR=""
+3 ;
+4 DO ^XBFMK
+5 SET DIR(0)="S^1:;2:;3:;4:;5:;6:;7:;8:;"
+6 SET DIR("L",1)="Select category into which the etiologic agent falls:"
+7 SET DIR("L",2)=""
+8 SET DIR("L",3)=" 1) BACTERIUM"
+9 SET DIR("L",4)=" 2) FUNGUS"
+10 SET DIR("L",5)=" 3) PARASITE"
+11 SET DIR("L",6)=" 4) MYCOBACTERIUM"
+12 SET DIR("L",7)=" 5) VIRUS"
+13 SET DIR("L",8)=" 6) CHEMICAL"
+14 SET DIR("L",9)=" 7) DRUG"
+15 SET DIR("L",10)=" 8) EXIT/NO SELECTION"
+16 SET DIR("L")=""
+17 SET DIR("A")="Selection"
+18 SET DIR("?")="This field identifies the category into which this etiologic agent falls."
+19 DO ^DIR
+20 ;
+21 IF +$GET(DIRUT)!(+$GET(Y)<1)
DO NOSELECT("IDENTIFIER")
QUIT
+22 ;
+23 SET IDENTIFR=$SELECT(Y=1:"B",Y=2:"F",Y=3:"P",Y=4:"M",Y=5:"V",Y=6:"C",Y=7:"D",1:"")
+24 QUIT
+25 ;
ABBREV ; EP - ABBREVIATION
+1 DO ^XBCLS
+2 SET ABBREV=""
+3 DO ^XBFMK
+4 SET DIR(0)="FO^1:5"
+5 SET DIR("A")="ABBREVIATION"
+6 DO ^DIR
+7 IF +$GET(DIRUT)
DO NOSELECT("CLASS/GROUP-TRIBE/FAMILY")
QUIT
+8 ;
+9 SET ABBREV=$GET(X)
+10 QUIT
+11 ;
SUSEDITT ; EP - SUSCEPTIBILITY EDIT TEMPLATE
+1 NEW ARRAY,CNT,DIRZERO,IEN,INDEX,TMPLNAME
+2 ;
+3 DO ^XBCLS
+4 SET SUSEDITT=""
+5 ;
+6 SET IEN=0
+7 FOR
SET IEN=$ORDER(^DIE(IEN))
IF IEN<1
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^DIE(IEN,0)),"^",4)=63
SET ARRAY($PIECE($GET(^(0)),"^"))=IEN
End DoDot:1
+9 ;
+10 SET DIRZERO="S^"
+11 SET CNT=0
SET TMPLNAME=""
+12 FOR
SET TMPLNAME=$ORDER(ARRAY(TMPLNAME))
IF TMPLNAME=""
QUIT
Begin DoDot:1
+13 SET CNT=CNT+1
+14 SET DIRZERO=DIRZERO_CNT_":;"
+15 SET DIRZERO(CNT)=$$LJ^XLFSTR($JUSTIFY(CNT,2)_") "_$EXTRACT(TMPLNAME,1,18),26)
+16 SET INDEX(CNT)=TMPLNAME
End DoDot:1
+17 ;
+18 ; Add EXIT/NO SELECTION
+19 SET CNT=CNT+1
+20 SET DIRZERO=DIRZERO_CNT_":;"
+21 SET DIRZERO(CNT)=$$LJ^XLFSTR($JUSTIFY(CNT,2)_") EXIT/NO SELECTION",26)
+22 SET INDEX(CNT)=""
+23 ;
+24 SET CNT=CNT+1
+25 SET DIRZERO=DIRZERO_(CNT)_":AL"
+26 ;
+27 DO ^XBFMK
+28 SET DIR(0)=DIRZERO
+29 SET DIR("L",1)="Select SUSCEPTIBILITY EDIT TEMPLATE:"
+30 SET DIR("L",2)=""
+31 SET BELOW=3
+32 SET CNT=0
+33 FOR
SET CNT=$ORDER(DIRZERO(CNT))
IF CNT<1
QUIT
Begin DoDot:1
+34 IF (CNT#3)=1
SET DIR("L",BELOW)=$JUSTIFY("",2)
+35 SET DIR("L",BELOW)=$GET(DIR("L",BELOW))_DIRZERO(CNT)
+36 IF (CNT#3)=0
SET BELOW=BELOW+1
End DoDot:1
+37 ;
+38 SET DIR("L")=""
+39 SET DIR("A")="Selection"
+40 SET DIR("?")="Contains the edit template name the etiologic agent is associated with."
+41 SET DIR("??")="Determines the set of antibiotics that will be shown for editing when this organism is chosen."
+42 DO ^DIR
+43 ;
+44 IF +$GET(DIRUT)
DO NOSELECT("SUSCEPTIBILITY EDIT TEMPLATE")
QUIT
+45 ;
+46 SET SUSEDITT=$GET(INDEX(Y))
+47 QUIT
+48 ;
HDEPTRPT ; EP - HEALTH DEPT REPORT
+1 DO ^XBCLS
+2 SET HDEPTRPT=""
+3 DO ^XBFMK
+4 SET DIR(0)="YO"
+5 SET DIR("A")="HEALTH DEPARTMENT REPORT"
+6 DO ^DIR
+7 IF +$GET(DIRUT)
DO NOSELECT("HEALTH DEPARTMENT REPORT")
QUIT
+8 ;
+9 SET HDEPTRPT=$EXTRACT(X)
+10 QUIT
+11 ;
DISPLAY(IEN) ; EP - Display the entry in 61.2
+1 SET DA=IEN
+2 SET DIC="^LAB(61.2,"
+3 DO EN^DIQ
+4 DO PRESSKEY^BLRGMENU(9)
+5 QUIT
+6 ;
NOSELECT(WOT) ; EP - Selection not done
+1 WRITE !,?4,WOT," not selected."
+2 WRITE !,?9,"None will be added to ETIOLOGY FIELD (#61.2) dictionary."
+3 DO PRESSKEY^BLRGMENU(4)
+4 QUIT
+5 ;
ERRORS ; EP - ERRS Array has data. Display it.
+1 WRITE !!,"ERRORS:",!
+2 SET J="ERRS"
+3 SET X=$GET(@J)
+4 WRITE ?4,J,"=",X,!
+5 FOR
SET J=$QUERY(@J)
IF J=""
QUIT
WRITE ?9,J,"=",@J,!
+6 ;
+7 DO PRESSKEY^BLRGMENU(4)
+8 QUIT
+9 ;
TESTIT ; EP
+1 NEW ERRS,FDA
+2 NEW SNOMEDSC,SNOMED,GRAMSTAN,IDENTIFR,ABBREV,SUSEDITT,HDEPTRPT,CGTRIBEF
+3 ;
+4 SET SNOMEDSC="Rubella antibody screening"
+5 SET SNOMED=375964015
+6 SET GRAMSTAN="P"
+7 SET IDENTIFR="B"
+8 SET ABBREV="RAS"
+9 SET SUSEDITT="GNS"
+10 SET HDEPTRPT="Y"
+11 SET CGTRIBEF="ENTEB"
+12 ;
+13 SET FDA(61.2,"+1,",.01)=SNOMEDSC
+14 SET FDA(61.2,"+1,",2)=SNOMED
+15 SET FDA(61.2,"+1,",3)=GRAMSTAN
+16 SET FDA(61.2,"+1,",4)=IDENTIFR
+17 SET FDA(61.2,"+1,",6)=ABBREV
+18 SET FDA(61.2,"+1,",8)=SUSEDITT
+19 SET FDA(61.2,"+1,",10)=HDEPTRPT
+20 SET FDA(61.2,"+1,",1.6)=CGTRIBEF
+21 ;
+22 DO UPDATE^DIE("ES","FDA",,"ERRS")
+23 IF $DATA(ERRS)
DO ERRORS
QUIT
+24 ;
+25 DO DISPLAY(+$$FIND1^DIC(61.2,,,SNOMEDSC))
+26 QUIT
