ORWLEX ; ISL/JER - RPCs wrapping Lexicon APIs;03/22/13 16:24 ;12/05/13 13:15
;;3.0;ORDER ENTRY/RESULTS REPORTING;**385**;Dec 17, 1997;Build 12
Q
GETI10DX(ORY,ORX,ORDT) ; RPC ORWLEX GET10DX
N FILTER,PSFIL S (FILTER,PSFIL)=""
S:+$G(ORDT)'>0 ORDT=DT
S ORX=$$UP^XLFSTR(ORX)
I ORX[" NOT " D
. N I,XNOT,XCT,X1,X2,FIL
. S XCT=$L(ORX," NOT ")
. F I=2:1:XCT S XNOT=$P(ORX," NOT ",I) Q:$L(XNOT)=0 D
.. S FILTER=FILTER_"I $$UP^XLFSTR(^LEX(757.01,+Y,0))'["""_XNOT_""" "
.. S PSFIL=PSFIL_"I $$UP^XLFSTR(ORTXT)'["""_XNOT_""" "
. I $E(FILTER,$L(FILTER))=" " S FILTER=$E(FILTER,1,$L(FILTER)-1)
. I $E(PSFIL,$L(PSFIL))=" " S PSFIL=$E(PSFIL,1,$L(PSFIL)-1)
. S XCT=$L(ORX," ")
. F I=1:1:XCT S X1=$P(ORX," ",I) D
.. I X1'="NOT" S X2=$G(X2)_X1_" " Q
.. I X1="NOT" S I=I+1
. S ORX=X2
. S FIL=$G(^TMP("LEXSCH",$J,"FIL",0)) I FIL'="" S FILTER=FIL_" "_FILTER
. S ^TMP("LEXSCH",$J,"FIL",0)=FILTER
I ORX[" OR " D Q
. N XCT,XCT1,XN,XN1
. S ^TMP($J,"ORWLEX","STEXT")=ORX
. S XCT1=$L(ORX," OR ")
. F XN=1:1:XCT1 S ORX=$P(^TMP($J,"ORWLEX","STEXT")," OR ") Q:$L(ORX)=0 S ^("STEXT")=$P(^TMP($J,"ORWLEX","STEXT")," OR ",2,XCT1) D
.. D SEARCH(.ORY,ORX,ORDT,FILTER,PSFIL)
.. M ^TMP($J,"ORWLEX","STEXT",XN)=ORY
.. K ORY
. S (XN,XCT)=0
. F S XN=$O(^TMP($J,"ORWLEX","STEXT",XN)) Q:+XN'>0 D
.. S XN1=0
.. F S XN1=$O(^TMP($J,"ORWLEX","STEXT",XN,XN1)) Q:+XN1'>0 S XCT=XCT+1,ORY(XCT)=^(XN1)
. K ^TMP($J,"ORWLEX","STEXT")
; execute the search
D SEARCH(.ORY,ORX,ORDT,FILTER,PSFIL)
Q
SEARCH(ORY,ORX,ORDT,ORFILTER,ORPSFIL) ; Call $$DIAGSRCH^LEX10CS to fetch I10 categories &/or codes
N ORLEXY,ORESULTS,ORCNT,ORI,ORJ,ORPRUNE,ORCODSYS,ORIMPDT
S ORIMPDT=$$IMPDATE^LEXU("10D")
S ORDT=$G(ORDT,DT),ORFILTER=$G(ORFILTER),ORPSFIL=$G(ORPSFIL)
S ORCODSYS=$S(ORDT'<ORIMPDT:"ICD-10-CM",1:"ICD-9-CM")
; Set Applications Default Flag (Lexicon can not overwrite filter)
S ^TMP("LEXSCH",$J,"ADF",0)=1
S ORLEXY=$$DIAGSRCH^LEX10CS(ORX,.ORESULTS,ORDT,"",ORFILTER)
I +ORLEXY=-1 D Q
. S ORY(1)=ORLEXY_U_ORCODSYS_U
S ORCNT=+$P(ORLEXY,U),ORPRUNE=+$P(ORLEXY,U,2)
S (ORI,ORJ)=0
F S ORI=$O(ORESULTS(ORI)) Q:+ORI'>0 D
. N ORLEX,ORTXT,ORCODE,ORICDID
. S ORJ=ORJ+1
. S ORLEX=+$G(ORESULTS(ORI,"LEX",1)) S:ORLEX=0 ORLEX="+"
. S ORTXT=$G(ORESULTS(ORI,"MENU"))
. I $L(ORPSFIL) X ORPSFIL Q:'$T
. S ORCODE=$P($G(ORESULTS(ORI,0)),U),ORICDID=+$$ICDDATA^ICDXCODE("DIAG",ORCODE,ORDT,"E")
. S ORY(ORJ)=$$SETELEM^ORWPCE4(ORLEX,ORTXT,ORCODSYS,ORCODE,ORDT)
. S $P(ORY(ORJ),U,9)=$S(+ORICDID:ORICDID,1:"")
I +ORLEXY=-2 S ORY(ORJ+1)=ORLEXY_U_ORCODSYS_U
Q
GETFREQ(ORY,ORSRCHTX) ; Call $$FREQ^LEXU to fetch the frequency of use of keywords contained in search string
S ORY=$$FREQ^LEXU(ORSRCHTX) ; ICR #5679
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWLEX 2750 printed Oct 16, 2024@18:37:07 Page 2
ORWLEX ; ISL/JER - RPCs wrapping Lexicon APIs;03/22/13 16:24 ;12/05/13 13:15
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**385**;Dec 17, 1997;Build 12
+2 QUIT
GETI10DX(ORY,ORX,ORDT) ; RPC ORWLEX GET10DX
+1 NEW FILTER,PSFIL
SET (FILTER,PSFIL)=""
+2 if +$GET(ORDT)'>0
SET ORDT=DT
+3 SET ORX=$$UP^XLFSTR(ORX)
+4 IF ORX[" NOT "
Begin DoDot:1
+5 NEW I,XNOT,XCT,X1,X2,FIL
+6 SET XCT=$LENGTH(ORX," NOT ")
+7 FOR I=2:1:XCT
SET XNOT=$PIECE(ORX," NOT ",I)
if $LENGTH(XNOT)=0
QUIT
Begin DoDot:2
+8 SET FILTER=FILTER_"I $$UP^XLFSTR(^LEX(757.01,+Y,0))'["""_XNOT_""" "
+9 SET PSFIL=PSFIL_"I $$UP^XLFSTR(ORTXT)'["""_XNOT_""" "
End DoDot:2
+10 IF $EXTRACT(FILTER,$LENGTH(FILTER))=" "
SET FILTER=$EXTRACT(FILTER,1,$LENGTH(FILTER)-1)
+11 IF $EXTRACT(PSFIL,$LENGTH(PSFIL))=" "
SET PSFIL=$EXTRACT(PSFIL,1,$LENGTH(PSFIL)-1)
+12 SET XCT=$LENGTH(ORX," ")
+13 FOR I=1:1:XCT
SET X1=$PIECE(ORX," ",I)
Begin DoDot:2
+14 IF X1'="NOT"
SET X2=$GET(X2)_X1_" "
QUIT
+15 IF X1="NOT"
SET I=I+1
End DoDot:2
+16 SET ORX=X2
+17 SET FIL=$GET(^TMP("LEXSCH",$JOB,"FIL",0))
IF FIL'=""
SET FILTER=FIL_" "_FILTER
+18 SET ^TMP("LEXSCH",$JOB,"FIL",0)=FILTER
End DoDot:1
+19 IF ORX[" OR "
Begin DoDot:1
+20 NEW XCT,XCT1,XN,XN1
+21 SET ^TMP($JOB,"ORWLEX","STEXT")=ORX
+22 SET XCT1=$LENGTH(ORX," OR ")
+23 FOR XN=1:1:XCT1
SET ORX=$PIECE(^TMP($JOB,"ORWLEX","STEXT")," OR ")
if $LENGTH(ORX)=0
QUIT
SET ^("STEXT")=$PIECE(^TMP($JOB,"ORWLEX","STEXT")," OR ",2,XCT1)
Begin DoDot:2
+24 DO SEARCH(.ORY,ORX,ORDT,FILTER,PSFIL)
+25 MERGE ^TMP($JOB,"ORWLEX","STEXT",XN)=ORY
+26 KILL ORY
End DoDot:2
+27 SET (XN,XCT)=0
+28 FOR
SET XN=$ORDER(^TMP($JOB,"ORWLEX","STEXT",XN))
if +XN'>0
QUIT
Begin DoDot:2
+29 SET XN1=0
+30 FOR
SET XN1=$ORDER(^TMP($JOB,"ORWLEX","STEXT",XN,XN1))
if +XN1'>0
QUIT
SET XCT=XCT+1
SET ORY(XCT)=^(XN1)
End DoDot:2
+31 KILL ^TMP($JOB,"ORWLEX","STEXT")
End DoDot:1
QUIT
+32 ; execute the search
+33 DO SEARCH(.ORY,ORX,ORDT,FILTER,PSFIL)
+34 QUIT
SEARCH(ORY,ORX,ORDT,ORFILTER,ORPSFIL) ; Call $$DIAGSRCH^LEX10CS to fetch I10 categories &/or codes
+1 NEW ORLEXY,ORESULTS,ORCNT,ORI,ORJ,ORPRUNE,ORCODSYS,ORIMPDT
+2 SET ORIMPDT=$$IMPDATE^LEXU("10D")
+3 SET ORDT=$GET(ORDT,DT)
SET ORFILTER=$GET(ORFILTER)
SET ORPSFIL=$GET(ORPSFIL)
+4 SET ORCODSYS=$SELECT(ORDT'<ORIMPDT:"ICD-10-CM",1:"ICD-9-CM")
+5 ; Set Applications Default Flag (Lexicon can not overwrite filter)
+6 SET ^TMP("LEXSCH",$JOB,"ADF",0)=1
+7 SET ORLEXY=$$DIAGSRCH^LEX10CS(ORX,.ORESULTS,ORDT,"",ORFILTER)
+8 IF +ORLEXY=-1
Begin DoDot:1
+9 SET ORY(1)=ORLEXY_U_ORCODSYS_U
End DoDot:1
QUIT
+10 SET ORCNT=+$PIECE(ORLEXY,U)
SET ORPRUNE=+$PIECE(ORLEXY,U,2)
+11 SET (ORI,ORJ)=0
+12 FOR
SET ORI=$ORDER(ORESULTS(ORI))
if +ORI'>0
QUIT
Begin DoDot:1
+13 NEW ORLEX,ORTXT,ORCODE,ORICDID
+14 SET ORJ=ORJ+1
+15 SET ORLEX=+$GET(ORESULTS(ORI,"LEX",1))
if ORLEX=0
SET ORLEX="+"
+16 SET ORTXT=$GET(ORESULTS(ORI,"MENU"))
+17 IF $LENGTH(ORPSFIL)
XECUTE ORPSFIL
if '$TEST
QUIT
+18 SET ORCODE=$PIECE($GET(ORESULTS(ORI,0)),U)
SET ORICDID=+$$ICDDATA^ICDXCODE("DIAG",ORCODE,ORDT,"E")
+19 SET ORY(ORJ)=$$SETELEM^ORWPCE4(ORLEX,ORTXT,ORCODSYS,ORCODE,ORDT)
+20 SET $PIECE(ORY(ORJ),U,9)=$SELECT(+ORICDID:ORICDID,1:"")
End DoDot:1
+21 IF +ORLEXY=-2
SET ORY(ORJ+1)=ORLEXY_U_ORCODSYS_U
+22 QUIT
GETFREQ(ORY,ORSRCHTX) ; Call $$FREQ^LEXU to fetch the frequency of use of keywords contained in search string
+1 ; ICR #5679
SET ORY=$$FREQ^LEXU(ORSRCHTX)
+2 QUIT
