- ORWPCE4 ;SLC/JM/REV - wrap calls to PCE and AICS ;May 26, 2022@12:27:43
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**306,361,350,423,465,405**;Dec 17, 1997;Build 211
- ;
- ; DBIA reference section
- ; 2950 LOOK^LEXA
- ; 1609 CONFIG^LEXSET
- ; 5006 $$GETSYN^LEXTRAN1
- ; 5679 $$IMPDATE^LEXU
- ; 5679 $$ONE^LEXU
- ; 10104 $$STRIP^XLFSTR
- ; 10104 $$TRIM^XLFSTR
- ; 10104 $$UP^XLFSTR
- ;
- Q
- LEX(LST,X,APP,ORDATE,ORXTND,ORINCSYN) ; return list after lexicon lookup IA#6441
- ; Call with: X (Required) The search text entered by the user
- ; APP (Required) The Lexicon APP parameter (e.g., "GMPX"
- ; for Problem List Subset, "10D" for ICD-10-CM, etc.
- ; [ORDATE] (Optional) the date of interest (Defaults to TODAY - should
- ; be passed as DATE OF SERVICE if not TODAY)
- ; [ORXTND] (Optional) Boolean flag specifying whether or not to
- ; use an extended search (Initial search is PL Subset
- ; of SCT, extended search is ICD (or 10D after impl.)
- ; (Defaults to 0 (FALSE))
- ; [ORINCSYN] (Optional) Boolean flag specifying whether or not to
- ; include synonyms for SNOMED CT Concepts
- ; (Defaults to 0 (FALSE))
- ;
- ; Returns: LST=local array name passed by ref, which contains search result set as:
- ; <lvn>(1..n)=LEXIEN^PREFTEXT^CODESYS^CONCEPTID^ICDVER^DESIGID^PARENTSUBSCRIPT
- ;
- N LEX,ILST,I,IEN,IMPLDT,SUBSET,FILTER,DIC
- S FILTER=""
- S IMPLDT=$$IMPDATE^LEXU("10D")
- S:APP="CPT" APP="CHP" ; LEX PATCH 10
- I APP="ICD",'+$G(ORXTND) S APP=$S($E(X,1,3)?.1A2.3N:"ICD",1:"GMPX")
- S:'+$G(ORDATE) ORDATE=DT
- S ORINCSYN=+$G(ORINCSYN)
- I APP="ICD",(ORDATE'<IMPLDT) S APP="10D"
- S SUBSET=$S(APP="GMPX":$S(ORDATE<IMPLDT:"PLS",1:"CLF"),1:APP)
- ; call CONFIG^LEXSET to set-up the constraints of the Lexicon search
- D CONFIG^LEXSET(APP,SUBSET,ORDATE) ;DBIA 1609
- I APP="CHP" D
- . ; Set the filter for CPT only using CS APIs - format is the same as for DIC("S")
- . S ^TMP("LEXSCH",$J,"FIL",0)="I $L($$CPTONE^LEXU(+Y,$G(ORDATE)))!($L($$CPCONE^LEXU(+Y,$G(ORDATE))))" ;DBIA 1609
- . ; Set Applications Default Flag (Lexicon can not overwrite filter)
- . S ^TMP("LEXSCH",$J,"ADF",0)=1
- ; setup and/or search
- S X=$$UP^XLFSTR(X)
- ; execute the search
- D SRCH(.LST,X,APP,SUBSET,ORDATE,ORINCSYN)
- K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J),^TMP("LEXSCH",$J),^TMP("LEXLE",$J)
- Q
- SRCH(LST,X,APP,SUBSET,ORDATE,ORINCSYN) ; call LOOK^LEXA to execute the search
- N LEX,I,IEN,ILST
- D LOOK^LEXA(X,APP,1,SUBSET,ORDATE)
- I '$D(LEX("LIST",1)) D Q
- . S LST(1)="-1^No matches found.^"_APP
- S ILST=0
- S LEX("LIST",1)=$$LEXXFRM(LEX("LIST",1),ORDATE,APP)
- I $S(APP="GMPX":1,APP="ICD":1,1:0),($P(LEX("LIST",1),U,6)'="799.9") D I 1
- . I APP="ICD",($E($P(LEX("LIST",1),U,3),1,3)'="ICD") Q
- . S LST(1)=LEX("LIST",1),ILST=1
- E S LST(1)=LEX("LIST",1),ILST=1
- I APP="GMPX",+$G(ORINCSYN) D SYNONYMS(.LST,.ILST,"SCT",$P(LST(1),U,4),ORDATE)
- S (I,IEN)=""
- F S I=$O(^TMP("LEXFND",$J,I)) Q:I="" D ;DBIA 2950
- .F S IEN=$O(^TMP("LEXFND",$J,I,IEN)) Q:IEN="" D
- ..N TXT,ELEMENT S TXT=^TMP("LEXFND",$J,I,IEN)
- ..S ELEMENT=IEN_U_TXT
- ..S ELEMENT=$$LEXXFRM(ELEMENT,ORDATE,APP) Q:$S(APP="GMPX":1,APP="ICD":1,1:0)&($P(ELEMENT,U,6)="799.9")
- ..I APP="ICD",($E($P(ELEMENT,U,3),1,3)'="ICD") Q
- ..I APP="SCT",$P(ELEMENT,U,4)="" Q
- ..S ILST=ILST+1,LST(ILST)=ELEMENT
- ..I APP="GMPX",+$G(ORINCSYN) D SYNONYMS(.LST,.ILST,"SCT",$P(LST(ILST),U,4),ORDATE)
- I '$D(LST(1)) S LST(1)="-1^No matches found.^"_APP
- Q
- LEXXFRM(ORX,ORDATE,ORAPP) ; Transform text for SCT look-up
- N ORLEX,ORY,ORICD,ORSCT,ORTXT,ORCODSYS,ORCCODE,ORDCODE
- S ORLEX=$P(ORX,U),ORTXT=$P(ORX,U,2),(ORCCODE,ORCODSYS)=""
- I ORTXT["*" S ORTXT=$$STRIP^XLFSTR(ORTXT,"*")
- I (ORTXT["("),(ORTXT[")") D I 1
- . S ORCODSYS=$RE($P($P($RE(ORTXT),"("),")",2))
- . S ORCCODE=$S(ORTXT["SNOMED":$$ONE^LEXU(+ORLEX,ORDATE,"SCT"),1:$RE($P($RE(ORCODSYS)," ")))
- . S ORCODSYS=$RE($P($RE(ORCODSYS)," ",2,99))
- . S ORTXT=$$TRIM^XLFSTR($RE($P($RE(ORTXT),"(",2,99)))
- E I ORAPP="SCT" D
- . S ORCODSYS="SNOMED CT",ORCCODE=$$ONE^LEXU(+ORLEX,ORDATE,"SCT")
- S ORY=$$SETELEM(ORLEX,ORTXT,ORCODSYS,ORCCODE,ORDATE)
- Q ORY
- SYNONYMS(LST,ILST,ORCSYS,ORCCODE,ORDT) ; Get synonyms for expression
- N ORSYN,ORI,ORDAD S ORDT=$G(ORDT,DT),ORDAD=ILST
- D GETSYN^LEXTRAN1(ORCSYS,ORCCODE,ORDT,"ORSYN",1,1)
- S ORI=0 F S ORI=$O(ORSYN("S",ORI)) Q:+ORI'>0 D
- . N ELEMENT,TXT,IEN,ORDCODE
- . S IEN=$P(ORSYN("S",ORI),U,2),TXT=$P(ORSYN("S",ORI),U),ORDCODE=$P(ORSYN("S",ORI),U,3)
- . S ELEMENT=$$SETELEM(IEN,TXT,"SNOMED CT",ORCCODE,ORDT,ORDCODE)_U_ORDAD
- . S ILST=ILST+1,LST(ILST)=ELEMENT
- Q
- SETELEM(ORLEX,ORTXT,ORCODSYS,ORCCODE,ORDATE,ORDCODE) ; Set List Element
- ;LEXIEN^PREFTEXT^CODESYS^CONCEPTID^ICDVER^ICDCODE^DESIGID^PARENTSUBSCRIPT
- N ORY,ORIMPDT,ORICD,ORSYN,ORTYP,ORQT,ORNUM,ORFULLNAME
- S ORIMPDT=$$IMPDATE^LEXU("10D"),(ORTYP,ORQT,ORNUM)=""
- S ORY=ORLEX_U_ORTXT_U_ORCODSYS_U_ORCCODE
- I $S(ORCODSYS["SNOMED":1,ORCODSYS["VHAT":1,1:0) D I 1
- . S ORY=ORY_U_$S(ORDATE<ORIMPDT:"ICD-9-CM",1:"ICD-10-CM"),ORICD=""
- . S ORICD=$$GETDX^ORQQPL1(ORCCODE,ORCODSYS,ORDATE)
- . I '$D(ORDCODE) D
- . . S ORDCODE=$$GETSYN^LEXTRAN1("SCT",ORCCODE,ORDATE,"ORSYN",1,1)
- . . I $P(ORDCODE,U)'=1 S ORDCODE="" Q
- . . ;S ORFULLNAME=$P($G(ORSYN("F")),U)
- . . F S ORTYP=$O(ORSYN(ORTYP)) Q:ORTYP="S"!(ORQT) D
- . . . I $P(ORSYN(ORTYP),U)=ORTXT S ORDCODE=$P(ORSYN(ORTYP),U,3),ORQT=1 Q
- . . I ORTYP="S" F S ORNUM=$O(ORSYN(ORTYP,ORNUM)) Q:ORNUM=""!(ORQT) D
- . . . I $P(ORSYN(ORTYP,ORNUM),U)=ORTXT S ORDCODE=$P(ORSYN(ORTYP,ORNUM),U,3),ORQT=1 Q
- . I ORDCODE["^" S ORDCODE=""
- . ;S ORY=ORY_U_$G(ORICD)_U_$G(ORDCODE)_U_U_U_$G(ORFULLNAME)
- . S ORY=ORY_U_$G(ORICD)_U_$G(ORDCODE)
- E S ORY=ORY_U_U
- Q ORY
- STDCODES(LST,X,APP,ORDATE) ; Standard Codes search
- N CNT,NODE,I,J,ILST,N0,N1,ELEMENT
- S ILST=0,NODE="ORWPCE4" K ^TMP(NODE,$J)
- S CNT=$$TAX^LEX10CS(X,APP,ORDATE,NODE,1)
- I CNT'>0 S LST(1)="-1^No matches found.^"_APP Q
- S I=0 F S I=$O(^TMP(NODE,$J,I)) Q:I="" D
- . S J=0 F S J=$O(^TMP(NODE,$J,I,J)) Q:J="" D
- . . S N1=$G(^TMP(NODE,$J,I,J,1))
- . . S N0=$G(^TMP(NODE,$J,I,J,1,0))
- . . S ELEMENT=$$LEXXFRM($P(N1,U,3)_U_$P(N0,U,2),ORDATE,APP)
- . . I APP="SCT",($P(ELEMENT,U,3)'="SNOMED CT")!($P(ELEMENT,U,4)="") Q
- . . S ILST=ILST+1,LST(ILST)=ELEMENT
- I '$D(LST(1)) S LST(1)="-1^No matches found.^"_APP
- K ^TMP(NODE,$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPCE4 6578 printed Jan 18, 2025@03:38:10 Page 2
- ORWPCE4 ;SLC/JM/REV - wrap calls to PCE and AICS ;May 26, 2022@12:27:43
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**306,361,350,423,465,405**;Dec 17, 1997;Build 211
- +2 ;
- +3 ; DBIA reference section
- +4 ; 2950 LOOK^LEXA
- +5 ; 1609 CONFIG^LEXSET
- +6 ; 5006 $$GETSYN^LEXTRAN1
- +7 ; 5679 $$IMPDATE^LEXU
- +8 ; 5679 $$ONE^LEXU
- +9 ; 10104 $$STRIP^XLFSTR
- +10 ; 10104 $$TRIM^XLFSTR
- +11 ; 10104 $$UP^XLFSTR
- +12 ;
- +13 QUIT
- LEX(LST,X,APP,ORDATE,ORXTND,ORINCSYN) ; return list after lexicon lookup IA#6441
- +1 ; Call with: X (Required) The search text entered by the user
- +2 ; APP (Required) The Lexicon APP parameter (e.g., "GMPX"
- +3 ; for Problem List Subset, "10D" for ICD-10-CM, etc.
- +4 ; [ORDATE] (Optional) the date of interest (Defaults to TODAY - should
- +5 ; be passed as DATE OF SERVICE if not TODAY)
- +6 ; [ORXTND] (Optional) Boolean flag specifying whether or not to
- +7 ; use an extended search (Initial search is PL Subset
- +8 ; of SCT, extended search is ICD (or 10D after impl.)
- +9 ; (Defaults to 0 (FALSE))
- +10 ; [ORINCSYN] (Optional) Boolean flag specifying whether or not to
- +11 ; include synonyms for SNOMED CT Concepts
- +12 ; (Defaults to 0 (FALSE))
- +13 ;
- +14 ; Returns: LST=local array name passed by ref, which contains search result set as:
- +15 ; <lvn>(1..n)=LEXIEN^PREFTEXT^CODESYS^CONCEPTID^ICDVER^DESIGID^PARENTSUBSCRIPT
- +16 ;
- +17 NEW LEX,ILST,I,IEN,IMPLDT,SUBSET,FILTER,DIC
- +18 SET FILTER=""
- +19 SET IMPLDT=$$IMPDATE^LEXU("10D")
- +20 ; LEX PATCH 10
- if APP="CPT"
- SET APP="CHP"
- +21 IF APP="ICD"
- IF '+$GET(ORXTND)
- SET APP=$SELECT($EXTRACT(X,1,3)?.1A2.3N:"ICD",1:"GMPX")
- +22 if '+$GET(ORDATE)
- SET ORDATE=DT
- +23 SET ORINCSYN=+$GET(ORINCSYN)
- +24 IF APP="ICD"
- IF (ORDATE'<IMPLDT)
- SET APP="10D"
- +25 SET SUBSET=$SELECT(APP="GMPX":$SELECT(ORDATE<IMPLDT:"PLS",1:"CLF"),1:APP)
- +26 ; call CONFIG^LEXSET to set-up the constraints of the Lexicon search
- +27 ;DBIA 1609
- DO CONFIG^LEXSET(APP,SUBSET,ORDATE)
- +28 IF APP="CHP"
- Begin DoDot:1
- +29 ; Set the filter for CPT only using CS APIs - format is the same as for DIC("S")
- +30 ;DBIA 1609
- SET ^TMP("LEXSCH",$JOB,"FIL",0)="I $L($$CPTONE^LEXU(+Y,$G(ORDATE)))!($L($$CPCONE^LEXU(+Y,$G(ORDATE))))"
- +31 ; Set Applications Default Flag (Lexicon can not overwrite filter)
- +32 SET ^TMP("LEXSCH",$JOB,"ADF",0)=1
- End DoDot:1
- +33 ; setup and/or search
- +34 SET X=$$UP^XLFSTR(X)
- +35 ; execute the search
- +36 DO SRCH(.LST,X,APP,SUBSET,ORDATE,ORINCSYN)
- +37 KILL ^TMP("LEXFND",$JOB),^TMP("LEXHIT",$JOB),^TMP("LEXSCH",$JOB),^TMP("LEXLE",$JOB)
- +38 QUIT
- SRCH(LST,X,APP,SUBSET,ORDATE,ORINCSYN) ; call LOOK^LEXA to execute the search
- +1 NEW LEX,I,IEN,ILST
- +2 DO LOOK^LEXA(X,APP,1,SUBSET,ORDATE)
- +3 IF '$DATA(LEX("LIST",1))
- Begin DoDot:1
- +4 SET LST(1)="-1^No matches found.^"_APP
- End DoDot:1
- QUIT
- +5 SET ILST=0
- +6 SET LEX("LIST",1)=$$LEXXFRM(LEX("LIST",1),ORDATE,APP)
- +7 IF $SELECT(APP="GMPX":1,APP="ICD":1,1:0)
- IF ($PIECE(LEX("LIST",1),U,6)'="799.9")
- Begin DoDot:1
- +8 IF APP="ICD"
- IF ($EXTRACT($PIECE(LEX("LIST",1),U,3),1,3)'="ICD")
- QUIT
- +9 SET LST(1)=LEX("LIST",1)
- SET ILST=1
- End DoDot:1
- IF 1
- +10 IF '$TEST
- SET LST(1)=LEX("LIST",1)
- SET ILST=1
- +11 IF APP="GMPX"
- IF +$GET(ORINCSYN)
- DO SYNONYMS(.LST,.ILST,"SCT",$PIECE(LST(1),U,4),ORDATE)
- +12 SET (I,IEN)=""
- +13 ;DBIA 2950
- FOR
- SET I=$ORDER(^TMP("LEXFND",$JOB,I))
- if I=""
- QUIT
- Begin DoDot:1
- +14 FOR
- SET IEN=$ORDER(^TMP("LEXFND",$JOB,I,IEN))
- if IEN=""
- QUIT
- Begin DoDot:2
- +15 NEW TXT,ELEMENT
- SET TXT=^TMP("LEXFND",$JOB,I,IEN)
- +16 SET ELEMENT=IEN_U_TXT
- +17 SET ELEMENT=$$LEXXFRM(ELEMENT,ORDATE,APP)
- if $SELECT(APP="GMPX"
- QUIT
- +18 IF APP="ICD"
- IF ($EXTRACT($PIECE(ELEMENT,U,3),1,3)'="ICD")
- QUIT
- +19 IF APP="SCT"
- IF $PIECE(ELEMENT,U,4)=""
- QUIT
- +20 SET ILST=ILST+1
- SET LST(ILST)=ELEMENT
- +21 IF APP="GMPX"
- IF +$GET(ORINCSYN)
- DO SYNONYMS(.LST,.ILST,"SCT",$PIECE(LST(ILST),U,4),ORDATE)
- End DoDot:2
- End DoDot:1
- +22 IF '$DATA(LST(1))
- SET LST(1)="-1^No matches found.^"_APP
- +23 QUIT
- LEXXFRM(ORX,ORDATE,ORAPP) ; Transform text for SCT look-up
- +1 NEW ORLEX,ORY,ORICD,ORSCT,ORTXT,ORCODSYS,ORCCODE,ORDCODE
- +2 SET ORLEX=$PIECE(ORX,U)
- SET ORTXT=$PIECE(ORX,U,2)
- SET (ORCCODE,ORCODSYS)=""
- +3 IF ORTXT["*"
- SET ORTXT=$$STRIP^XLFSTR(ORTXT,"*")
- +4 IF (ORTXT["(")
- IF (ORTXT[")")
- Begin DoDot:1
- +5 SET ORCODSYS=$REVERSE($PIECE($PIECE($REVERSE(ORTXT),"("),")",2))
- +6 SET ORCCODE=$SELECT(ORTXT["SNOMED":$$ONE^LEXU(+ORLEX,ORDATE,"SCT"),1:$REVERSE($PIECE($REVERSE(ORCODSYS)," ")))
- +7 SET ORCODSYS=$REVERSE($PIECE($REVERSE(ORCODSYS)," ",2,99))
- +8 SET ORTXT=$$TRIM^XLFSTR($REVERSE($PIECE($REVERSE(ORTXT),"(",2,99)))
- End DoDot:1
- IF 1
- +9 IF '$TEST
- IF ORAPP="SCT"
- Begin DoDot:1
- +10 SET ORCODSYS="SNOMED CT"
- SET ORCCODE=$$ONE^LEXU(+ORLEX,ORDATE,"SCT")
- End DoDot:1
- +11 SET ORY=$$SETELEM(ORLEX,ORTXT,ORCODSYS,ORCCODE,ORDATE)
- +12 QUIT ORY
- SYNONYMS(LST,ILST,ORCSYS,ORCCODE,ORDT) ; Get synonyms for expression
- +1 NEW ORSYN,ORI,ORDAD
- SET ORDT=$GET(ORDT,DT)
- SET ORDAD=ILST
- +2 DO GETSYN^LEXTRAN1(ORCSYS,ORCCODE,ORDT,"ORSYN",1,1)
- +3 SET ORI=0
- FOR
- SET ORI=$ORDER(ORSYN("S",ORI))
- if +ORI'>0
- QUIT
- Begin DoDot:1
- +4 NEW ELEMENT,TXT,IEN,ORDCODE
- +5 SET IEN=$PIECE(ORSYN("S",ORI),U,2)
- SET TXT=$PIECE(ORSYN("S",ORI),U)
- SET ORDCODE=$PIECE(ORSYN("S",ORI),U,3)
- +6 SET ELEMENT=$$SETELEM(IEN,TXT,"SNOMED CT",ORCCODE,ORDT,ORDCODE)_U_ORDAD
- +7 SET ILST=ILST+1
- SET LST(ILST)=ELEMENT
- End DoDot:1
- +8 QUIT
- SETELEM(ORLEX,ORTXT,ORCODSYS,ORCCODE,ORDATE,ORDCODE) ; Set List Element
- +1 ;LEXIEN^PREFTEXT^CODESYS^CONCEPTID^ICDVER^ICDCODE^DESIGID^PARENTSUBSCRIPT
- +2 NEW ORY,ORIMPDT,ORICD,ORSYN,ORTYP,ORQT,ORNUM,ORFULLNAME
- +3 SET ORIMPDT=$$IMPDATE^LEXU("10D")
- SET (ORTYP,ORQT,ORNUM)=""
- +4 SET ORY=ORLEX_U_ORTXT_U_ORCODSYS_U_ORCCODE
- +5 IF $SELECT(ORCODSYS["SNOMED":1,ORCODSYS["VHAT":1,1:0)
- Begin DoDot:1
- +6 SET ORY=ORY_U_$SELECT(ORDATE<ORIMPDT:"ICD-9-CM",1:"ICD-10-CM")
- SET ORICD=""
- +7 SET ORICD=$$GETDX^ORQQPL1(ORCCODE,ORCODSYS,ORDATE)
- +8 IF '$DATA(ORDCODE)
- Begin DoDot:2
- +9 SET ORDCODE=$$GETSYN^LEXTRAN1("SCT",ORCCODE,ORDATE,"ORSYN",1,1)
- +10 IF $PIECE(ORDCODE,U)'=1
- SET ORDCODE=""
- QUIT
- +11 ;S ORFULLNAME=$P($G(ORSYN("F")),U)
- +12 FOR
- SET ORTYP=$ORDER(ORSYN(ORTYP))
- if ORTYP="S"!(ORQT)
- QUIT
- Begin DoDot:3
- +13 IF $PIECE(ORSYN(ORTYP),U)=ORTXT
- SET ORDCODE=$PIECE(ORSYN(ORTYP),U,3)
- SET ORQT=1
- QUIT
- End DoDot:3
- +14 IF ORTYP="S"
- FOR
- SET ORNUM=$ORDER(ORSYN(ORTYP,ORNUM))
- if ORNUM=""!(ORQT)
- QUIT
- Begin DoDot:3
- +15 IF $PIECE(ORSYN(ORTYP,ORNUM),U)=ORTXT
- SET ORDCODE=$PIECE(ORSYN(ORTYP,ORNUM),U,3)
- SET ORQT=1
- QUIT
- End DoDot:3
- End DoDot:2
- +16 IF ORDCODE["^"
- SET ORDCODE=""
- +17 ;S ORY=ORY_U_$G(ORICD)_U_$G(ORDCODE)_U_U_U_$G(ORFULLNAME)
- +18 SET ORY=ORY_U_$GET(ORICD)_U_$GET(ORDCODE)
- End DoDot:1
- IF 1
- +19 IF '$TEST
- SET ORY=ORY_U_U
- +20 QUIT ORY
- STDCODES(LST,X,APP,ORDATE) ; Standard Codes search
- +1 NEW CNT,NODE,I,J,ILST,N0,N1,ELEMENT
- +2 SET ILST=0
- SET NODE="ORWPCE4"
- KILL ^TMP(NODE,$JOB)
- +3 SET CNT=$$TAX^LEX10CS(X,APP,ORDATE,NODE,1)
- +4 IF CNT'>0
- SET LST(1)="-1^No matches found.^"_APP
- QUIT
- +5 SET I=0
- FOR
- SET I=$ORDER(^TMP(NODE,$JOB,I))
- if I=""
- QUIT
- Begin DoDot:1
- +6 SET J=0
- FOR
- SET J=$ORDER(^TMP(NODE,$JOB,I,J))
- if J=""
- QUIT
- Begin DoDot:2
- +7 SET N1=$GET(^TMP(NODE,$JOB,I,J,1))
- +8 SET N0=$GET(^TMP(NODE,$JOB,I,J,1,0))
- +9 SET ELEMENT=$$LEXXFRM($PIECE(N1,U,3)_U_$PIECE(N0,U,2),ORDATE,APP)
- +10 IF APP="SCT"
- IF ($PIECE(ELEMENT,U,3)'="SNOMED CT")!($PIECE(ELEMENT,U,4)="")
- QUIT
- +11 SET ILST=ILST+1
- SET LST(ILST)=ELEMENT
- End DoDot:2
- End DoDot:1
- +12 IF '$DATA(LST(1))
- SET LST(1)="-1^No matches found.^"_APP
- +13 KILL ^TMP(NODE,$JOB)
- +14 QUIT