Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EDPFLEX

EDPFLEX.m

Go to the documentation of this file.
  1. EDPFLEX ;SLC/KCM - Lexicon Utilities ;2/28/12 08:33am
  1. ;;2.0;EMERGENCY DEPARTMENT;**2**;Feb 24, 2012;Build 23
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; $$DIAGSRCH^LEX10CS ICR 5681
  1. ;....CONFIG^LEXSET...........ICR...1609
  1. ;....LOOK^LEXA...............ICR...2950
  1. ;
  1. ICD(TEXT) ; Return Lexicon hits for TEXT
  1. ; Begin EDP*2.0*2 changes drp 04052012
  1. N LEX,X,Y,I,ICD,CPT,NAME,IEN,EDPCSYS,EDPRTN,EDPDOI,EDPMSG,EDPLMT
  1. S EDPDOI=$P(REQ("inTS",1),"."),EDPLMT='($G(REQ("ignoreThreshold",1),0)),EDPMSG=0
  1. S EDPCSYS=$$CSYS^EDPLEX(EDPDOI),EDPICDVER=$$VER^EDPLEX(EDPCSYS) ;drp
  1. ; Add validation for ICDVER after the set.
  1. D CONFIG^LEXSET("ICD","ICD",EDPDOI)
  1. I EDPCSYS="ICD" D LOOK^LEXA(TEXT,"ICD",999,"",EDPDOI) D ICD9(.LEX)
  1. I EDPCSYS="10D" D
  1. . S EDPMSG=$$TOOHI^EDPLEX(TEXT,EDPCSYS,EDPLMT)
  1. . I EDPLMT,+EDPMSG S LEX(1,"MSG")=$P(EDPMSG,U,2)
  1. . I '+EDPMSG S EDPRTN=$$DIAGSRCH^LEX10CS(TEXT,.LEX,EDPDOI,999) D
  1. . . S:+EDPRTN=-1 LEX(1,"MSG")=$S($P($G(EDPRTN),"^",2):$P($G(EDPRTN),"^",2),1:"NO MATCH FOUND")
  1. . .Q
  1. . S LEX(1,"2HI")=+EDPMSG
  1. . D ICD10(.LEX)
  1. .Q
  1. K EDPICDVER
  1. Q
  1. ;
  1. ICD9(LEX) ; BUILD ICD 9 SEARCH ARRAY
  1. ; this tag was renamed, but is essentially the old code with one change.
  1. N I,ITEM
  1. D XML^EDPX("<items>")
  1. S I=0 F S I=$O(LEX("LIST",I)) Q:I<1 D
  1. . K ITEM
  1. . S IEN=$P(LEX("LIST",I),U),X=$P(LEX("LIST",I),U,2),CPT=""
  1. . ;replaced line below with one that follows
  1. . ;S ICD=$P($P(X,"ICD-9-CM ",2),")") I $L(ICD) S NAME=X
  1. . S ICD=$P($P(X,EDPICDVER_" ",2),")") I $L(ICD) S NAME=X ;$P(X,"ICD-9-CM ",2) removed hardcoded ref drp
  1. . E S CPT=$P($P(X,"CPT-4 ",2),")"),NAME=X ;$P(X," (CPT-4")
  1. . I '$L(ICD),'$L(CPT) Q
  1. . S:$E(NAME,$L(NAME))="*" NAME=$E(NAME,1,$L(NAME)-2)
  1. . S ITEM("text")=NAME,ITEM("ien")=IEN,ITEM("icdType")=EDPICDVER
  1. . I $L(ICD) S ITEM("code")=ICD,ITEM("type")="POV",ITEM("icd")=ICD
  1. . I $L(CPT) S ITEM("code")=CPT,ITEM("type")="CPT",ITEM("cpt")=CPT
  1. . S Y=$$XMLA^EDPX("item",.ITEM) D XML^EDPX(Y)
  1. D XML^EDPX("</items>")
  1. Q
  1. ICD10(LEX) ; BUILD ICD 10 SEARCH ARRAY THERE ARE NO CPT'S
  1. ;tag added 04052012 drp EDP*2.0*2
  1. N I,ITEM
  1. D XML^EDPX("<items>")
  1. S I=0 F S I=$O(LEX(I)) Q:I<1 D
  1. . K ITEM S X=""
  1. . S ITEM("thresholdReached")=$G(LEX(1,"2HI"),-1) ; Value should be 0 or 1, -1 denotes error state
  1. . S:$D(LEX(I,"MSG")) ITEM("userMessage")=LEX(I,"MSG")
  1. . S:$D(LEX(I,"IDS",1)) IEN=$P(LEX(I,"IDS",1),U),X=LEX(I,"IDS"),ITEM("childrenCount")=0
  1. . S:$D(LEX(I,"CAT")) IEN="",X=LEX(I,"MENU"),ITEM("childrenCount")=$P(LEX(I,0),U,3)
  1. . S ICD=$P($G(LEX(I,0),$G(LEX(I,"MSG"))),U) I $L(ICD),$L(X) S NAME=X_" ("_$G(EDPICDVER)_" "_ICD_")"
  1. . I '$L(ICD) Q
  1. . I $G(NAME)'="" S:$E(NAME,$L(NAME))="*" NAME=$E(NAME,1,$L(NAME)-2)
  1. . S ITEM("text")=$G(NAME),ITEM("icdType")=EDPICDVER
  1. . S:$G(IEN)'="" ITEM("ien")=IEN
  1. . I $L(ICD) S ITEM("code")=ICD,ITEM("type")="POV",ITEM("icd")=ICD
  1. . ;M ITEM(I)=LEX(I)
  1. . S Y=$$XMLQA^EDPX("item",.ITEM) D XML^EDPX(Y)
  1. .Q
  1. D XML^EDPX("</items>")
  1. Q