MDRPCWU ;HOIFO/NCA - CPT Code Query ;2/16/10 16:17
;;1.0;CLINICAL PROCEDURES;**21,29**;Apr 01, 2004;Build 22
; Reference Integration Agreement:
; IA #1573 [Supported] LEXU calls
; IA #1609 [Supported] CONFIG^LEXSET call
; IA #2950 [Supported] LOOK^LEXA call
; IA #5747 [Supported] $$SINFO^ICDEX
;
CPTLEX(RESLT,MDSRCH,MDAPP) ; CPT Code Query
N CODE,LEX,MDLST,MDI,LEXIEN,MDVAL
S RESLT=$NA(^TMP("MDLEX",$J)) K @RESLT
S MDDATE=DT
S:MDAPP="CPT" MDAPP="CHP" ; LEX PATCH 10
I MDAPP="ICD" S MDAPP=$P($$SINFO^ICDEX("DIAG",MDDATE),"^",3)
D CONFIG^LEXSET(MDAPP,MDAPP,MDDATE)
D LOOK^LEXA(MDSRCH,MDAPP,1,"",MDDATE)
I '$D(LEX("LIST",1)) S @RESLT@(1)="-1^No matches found." Q
S @RESLT@(1)=LEX("LIST",1),MDLST=1
S MDI="" F S MDI=$O(^TMP("LEXFND",$J,MDI)) Q:MDI'<0 D
. S LEXIEN=$O(^TMP("LEXFND",$J,MDI,0))
. S MDLST=MDLST+1,@RESLT@(MDLST)=LEXIEN_U_^TMP("LEXFND",$J,MDI,LEXIEN)
K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J)
S MDI="" F S MDI=$O(@RESLT@(MDI)) Q:'MDI S MDVAL=$G(@RESLT@(MDI)) D
. I MDAPP="ICD"!(MDAPP="10D") S CODE=$$ONE^LEXU(+MDVAL,MDDATE,MDAPP),@RESLT@(MDI)=CODE_U_MDVAL
. I MDAPP="CPT"!(MDAPP="CHP") S CODE=$$CPTONE^LEXU(+MDVAL,MDDATE),@RESLT@(MDI)=CODE_U_MDVAL
. I CODE="",(MDAPP="CHP") S CODE=$$CPCONE^LEXU(+MDVAL,MDDATE),@RESLT@(MDI)=CODE_U_MDVAL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDRPCWU 1300 printed Oct 16, 2024@17:45:08 Page 2
MDRPCWU ;HOIFO/NCA - CPT Code Query ;2/16/10 16:17
+1 ;;1.0;CLINICAL PROCEDURES;**21,29**;Apr 01, 2004;Build 22
+2 ; Reference Integration Agreement:
+3 ; IA #1573 [Supported] LEXU calls
+4 ; IA #1609 [Supported] CONFIG^LEXSET call
+5 ; IA #2950 [Supported] LOOK^LEXA call
+6 ; IA #5747 [Supported] $$SINFO^ICDEX
+7 ;
CPTLEX(RESLT,MDSRCH,MDAPP) ; CPT Code Query
+1 NEW CODE,LEX,MDLST,MDI,LEXIEN,MDVAL
+2 SET RESLT=$NAME(^TMP("MDLEX",$JOB))
KILL @RESLT
+3 SET MDDATE=DT
+4 ; LEX PATCH 10
if MDAPP="CPT"
SET MDAPP="CHP"
+5 IF MDAPP="ICD"
SET MDAPP=$PIECE($$SINFO^ICDEX("DIAG",MDDATE),"^",3)
+6 DO CONFIG^LEXSET(MDAPP,MDAPP,MDDATE)
+7 DO LOOK^LEXA(MDSRCH,MDAPP,1,"",MDDATE)
+8 IF '$DATA(LEX("LIST",1))
SET @RESLT@(1)="-1^No matches found."
QUIT
+9 SET @RESLT@(1)=LEX("LIST",1)
SET MDLST=1
+10 SET MDI=""
FOR
SET MDI=$ORDER(^TMP("LEXFND",$JOB,MDI))
if MDI'<0
QUIT
Begin DoDot:1
+11 SET LEXIEN=$ORDER(^TMP("LEXFND",$JOB,MDI,0))
+12 SET MDLST=MDLST+1
SET @RESLT@(MDLST)=LEXIEN_U_^TMP("LEXFND",$JOB,MDI,LEXIEN)
End DoDot:1
+13 KILL ^TMP("LEXFND",$JOB),^TMP("LEXHIT",$JOB)
+14 SET MDI=""
FOR
SET MDI=$ORDER(@RESLT@(MDI))
if 'MDI
QUIT
SET MDVAL=$GET(@RESLT@(MDI))
Begin DoDot:1
+15 IF MDAPP="ICD"!(MDAPP="10D")
SET CODE=$$ONE^LEXU(+MDVAL,MDDATE,MDAPP)
SET @RESLT@(MDI)=CODE_U_MDVAL
+16 IF MDAPP="CPT"!(MDAPP="CHP")
SET CODE=$$CPTONE^LEXU(+MDVAL,MDDATE)
SET @RESLT@(MDI)=CODE_U_MDVAL
+17 IF CODE=""
IF (MDAPP="CHP")
SET CODE=$$CPCONE^LEXU(+MDVAL,MDDATE)
SET @RESLT@(MDI)=CODE_U_MDVAL
End DoDot:1
+18 QUIT
