MDRPCWU.m

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 ---MDRPCWU   1300     printed  Apr 09, 2024@20:49:29                                                                                                                                                                                                     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