- EDPFLEX ;SLC/KCM - Lexicon Utilities ;2/28/12 08:33am
- ;;2.0;EMERGENCY DEPARTMENT;**2**;Feb 24, 2012;Build 23
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; $$DIAGSRCH^LEX10CS ICR 5681
- ;....CONFIG^LEXSET...........ICR...1609
- ;....LOOK^LEXA...............ICR...2950
- ;
- ICD(TEXT) ; Return Lexicon hits for TEXT
- ; Begin EDP*2.0*2 changes drp 04052012
- N LEX,X,Y,I,ICD,CPT,NAME,IEN,EDPCSYS,EDPRTN,EDPDOI,EDPMSG,EDPLMT
- S EDPDOI=$P(REQ("inTS",1),"."),EDPLMT='($G(REQ("ignoreThreshold",1),0)),EDPMSG=0
- S EDPCSYS=$$CSYS^EDPLEX(EDPDOI),EDPICDVER=$$VER^EDPLEX(EDPCSYS) ;drp
- ; Add validation for ICDVER after the set.
- D CONFIG^LEXSET("ICD","ICD",EDPDOI)
- I EDPCSYS="ICD" D LOOK^LEXA(TEXT,"ICD",999,"",EDPDOI) D ICD9(.LEX)
- I EDPCSYS="10D" D
- . S EDPMSG=$$TOOHI^EDPLEX(TEXT,EDPCSYS,EDPLMT)
- . I EDPLMT,+EDPMSG S LEX(1,"MSG")=$P(EDPMSG,U,2)
- . I '+EDPMSG S EDPRTN=$$DIAGSRCH^LEX10CS(TEXT,.LEX,EDPDOI,999) D
- . . S:+EDPRTN=-1 LEX(1,"MSG")=$S($P($G(EDPRTN),"^",2):$P($G(EDPRTN),"^",2),1:"NO MATCH FOUND")
- . .Q
- . S LEX(1,"2HI")=+EDPMSG
- . D ICD10(.LEX)
- .Q
- K EDPICDVER
- Q
- ;
- ICD9(LEX) ; BUILD ICD 9 SEARCH ARRAY
- ; this tag was renamed, but is essentially the old code with one change.
- N I,ITEM
- D XML^EDPX("<items>")
- S I=0 F S I=$O(LEX("LIST",I)) Q:I<1 D
- . K ITEM
- . S IEN=$P(LEX("LIST",I),U),X=$P(LEX("LIST",I),U,2),CPT=""
- . ;replaced line below with one that follows
- . ;S ICD=$P($P(X,"ICD-9-CM ",2),")") I $L(ICD) S NAME=X
- . S ICD=$P($P(X,EDPICDVER_" ",2),")") I $L(ICD) S NAME=X ;$P(X,"ICD-9-CM ",2) removed hardcoded ref drp
- . E S CPT=$P($P(X,"CPT-4 ",2),")"),NAME=X ;$P(X," (CPT-4")
- . I '$L(ICD),'$L(CPT) Q
- . S:$E(NAME,$L(NAME))="*" NAME=$E(NAME,1,$L(NAME)-2)
- . S ITEM("text")=NAME,ITEM("ien")=IEN,ITEM("icdType")=EDPICDVER
- . I $L(ICD) S ITEM("code")=ICD,ITEM("type")="POV",ITEM("icd")=ICD
- . I $L(CPT) S ITEM("code")=CPT,ITEM("type")="CPT",ITEM("cpt")=CPT
- . S Y=$$XMLA^EDPX("item",.ITEM) D XML^EDPX(Y)
- D XML^EDPX("</items>")
- Q
- ICD10(LEX) ; BUILD ICD 10 SEARCH ARRAY THERE ARE NO CPT'S
- ;tag added 04052012 drp EDP*2.0*2
- N I,ITEM
- D XML^EDPX("<items>")
- S I=0 F S I=$O(LEX(I)) Q:I<1 D
- . K ITEM S X=""
- . S ITEM("thresholdReached")=$G(LEX(1,"2HI"),-1) ; Value should be 0 or 1, -1 denotes error state
- . S:$D(LEX(I,"MSG")) ITEM("userMessage")=LEX(I,"MSG")
- . S:$D(LEX(I,"IDS",1)) IEN=$P(LEX(I,"IDS",1),U),X=LEX(I,"IDS"),ITEM("childrenCount")=0
- . S:$D(LEX(I,"CAT")) IEN="",X=LEX(I,"MENU"),ITEM("childrenCount")=$P(LEX(I,0),U,3)
- . S ICD=$P($G(LEX(I,0),$G(LEX(I,"MSG"))),U) I $L(ICD),$L(X) S NAME=X_" ("_$G(EDPICDVER)_" "_ICD_")"
- . I '$L(ICD) Q
- . I $G(NAME)'="" S:$E(NAME,$L(NAME))="*" NAME=$E(NAME,1,$L(NAME)-2)
- . S ITEM("text")=$G(NAME),ITEM("icdType")=EDPICDVER
- . S:$G(IEN)'="" ITEM("ien")=IEN
- . I $L(ICD) S ITEM("code")=ICD,ITEM("type")="POV",ITEM("icd")=ICD
- . ;M ITEM(I)=LEX(I)
- . S Y=$$XMLQA^EDPX("item",.ITEM) D XML^EDPX(Y)
- .Q
- D XML^EDPX("</items>")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPFLEX 2995 printed Feb 18, 2025@23:18:13 Page 2
- EDPFLEX ;SLC/KCM - Lexicon Utilities ;2/28/12 08:33am
- +1 ;;2.0;EMERGENCY DEPARTMENT;**2**;Feb 24, 2012;Build 23
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; $$DIAGSRCH^LEX10CS ICR 5681
- +5 ;....CONFIG^LEXSET...........ICR...1609
- +6 ;....LOOK^LEXA...............ICR...2950
- +7 ;
- ICD(TEXT) ; Return Lexicon hits for TEXT
- +1 ; Begin EDP*2.0*2 changes drp 04052012
- +2 NEW LEX,X,Y,I,ICD,CPT,NAME,IEN,EDPCSYS,EDPRTN,EDPDOI,EDPMSG,EDPLMT
- +3 SET EDPDOI=$PIECE(REQ("inTS",1),".")
- SET EDPLMT='($GET(REQ("ignoreThreshold",1),0))
- SET EDPMSG=0
- +4 ;drp
- SET EDPCSYS=$$CSYS^EDPLEX(EDPDOI)
- SET EDPICDVER=$$VER^EDPLEX(EDPCSYS)
- +5 ; Add validation for ICDVER after the set.
- +6 DO CONFIG^LEXSET("ICD","ICD",EDPDOI)
- +7 IF EDPCSYS="ICD"
- DO LOOK^LEXA(TEXT,"ICD",999,"",EDPDOI)
- DO ICD9(.LEX)
- +8 IF EDPCSYS="10D"
- Begin DoDot:1
- +9 SET EDPMSG=$$TOOHI^EDPLEX(TEXT,EDPCSYS,EDPLMT)
- +10 IF EDPLMT
- IF +EDPMSG
- SET LEX(1,"MSG")=$PIECE(EDPMSG,U,2)
- +11 IF '+EDPMSG
- SET EDPRTN=$$DIAGSRCH^LEX10CS(TEXT,.LEX,EDPDOI,999)
- Begin DoDot:2
- +12 if +EDPRTN=-1
- SET LEX(1,"MSG")=$SELECT($PIECE($GET(EDPRTN),"^",2):$PIECE($GET(EDPRTN),"^",2),1:"NO MATCH FOUND")
- +13 QUIT
- End DoDot:2
- +14 SET LEX(1,"2HI")=+EDPMSG
- +15 DO ICD10(.LEX)
- +16 QUIT
- End DoDot:1
- +17 KILL EDPICDVER
- +18 QUIT
- +19 ;
- ICD9(LEX) ; BUILD ICD 9 SEARCH ARRAY
- +1 ; this tag was renamed, but is essentially the old code with one change.
- +2 NEW I,ITEM
- +3 DO XML^EDPX("<items>")
- +4 SET I=0
- FOR
- SET I=$ORDER(LEX("LIST",I))
- if I<1
- QUIT
- Begin DoDot:1
- +5 KILL ITEM
- +6 SET IEN=$PIECE(LEX("LIST",I),U)
- SET X=$PIECE(LEX("LIST",I),U,2)
- SET CPT=""
- +7 ;replaced line below with one that follows
- +8 ;S ICD=$P($P(X,"ICD-9-CM ",2),")") I $L(ICD) S NAME=X
- +9 ;$P(X,"ICD-9-CM ",2) removed hardcoded ref drp
- SET ICD=$PIECE($PIECE(X,EDPICDVER_" ",2),")")
- IF $LENGTH(ICD)
- SET NAME=X
- +10 ;$P(X," (CPT-4")
- IF '$TEST
- SET CPT=$PIECE($PIECE(X,"CPT-4 ",2),")")
- SET NAME=X
- +11 IF '$LENGTH(ICD)
- IF '$LENGTH(CPT)
- QUIT
- +12 if $EXTRACT(NAME,$LENGTH(NAME))="*"
- SET NAME=$EXTRACT(NAME,1,$LENGTH(NAME)-2)
- +13 SET ITEM("text")=NAME
- SET ITEM("ien")=IEN
- SET ITEM("icdType")=EDPICDVER
- +14 IF $LENGTH(ICD)
- SET ITEM("code")=ICD
- SET ITEM("type")="POV"
- SET ITEM("icd")=ICD
- +15 IF $LENGTH(CPT)
- SET ITEM("code")=CPT
- SET ITEM("type")="CPT"
- SET ITEM("cpt")=CPT
- +16 SET Y=$$XMLA^EDPX("item",.ITEM)
- DO XML^EDPX(Y)
- End DoDot:1
- +17 DO XML^EDPX("</items>")
- +18 QUIT
- ICD10(LEX) ; BUILD ICD 10 SEARCH ARRAY THERE ARE NO CPT'S
- +1 ;tag added 04052012 drp EDP*2.0*2
- +2 NEW I,ITEM
- +3 DO XML^EDPX("<items>")
- +4 SET I=0
- FOR
- SET I=$ORDER(LEX(I))
- if I<1
- QUIT
- Begin DoDot:1
- +5 KILL ITEM
- SET X=""
- +6 ; Value should be 0 or 1, -1 denotes error state
- SET ITEM("thresholdReached")=$GET(LEX(1,"2HI"),-1)
- +7 if $DATA(LEX(I,"MSG"))
- SET ITEM("userMessage")=LEX(I,"MSG")
- +8 if $DATA(LEX(I,"IDS",1))
- SET IEN=$PIECE(LEX(I,"IDS",1),U)
- SET X=LEX(I,"IDS")
- SET ITEM("childrenCount")=0
- +9 if $DATA(LEX(I,"CAT"))
- SET IEN=""
- SET X=LEX(I,"MENU")
- SET ITEM("childrenCount")=$PIECE(LEX(I,0),U,3)
- +10 SET ICD=$PIECE($GET(LEX(I,0),$GET(LEX(I,"MSG"))),U)
- IF $LENGTH(ICD)
- IF $LENGTH(X)
- SET NAME=X_" ("_$GET(EDPICDVER)_" "_ICD_")"
- +11 IF '$LENGTH(ICD)
- QUIT
- +12 IF $GET(NAME)'=""
- if $EXTRACT(NAME,$LENGTH(NAME))="*"
- SET NAME=$EXTRACT(NAME,1,$LENGTH(NAME)-2)
- +13 SET ITEM("text")=$GET(NAME)
- SET ITEM("icdType")=EDPICDVER
- +14 if $GET(IEN)'=""
- SET ITEM("ien")=IEN
- +15 IF $LENGTH(ICD)
- SET ITEM("code")=ICD
- SET ITEM("type")="POV"
- SET ITEM("icd")=ICD
- +16 ;M ITEM(I)=LEX(I)
- +17 SET Y=$$XMLQA^EDPX("item",.ITEM)
- DO XML^EDPX(Y)
- +18 QUIT
- End DoDot:1
- +19 DO XML^EDPX("</items>")
- +20 QUIT