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

ICDDSLK.m

Go to the documentation of this file. 
ICDDSLK ;KUM/SJA/SS - ICD-10 DIAGNOSIS CODE LOOK UP;12-06-11

 ;;18.0;DRG Grouper;**64**;Oct 20, 2000;Build 103

 ;

 ; ICDDATE is EFFECTIVE DATE that passed from Calling routine

EN ; ENTRY

 D INITVARS ;set standards variables, you might not need this if it was already done in your application  

 N ICDQUIT ; to manage demo loop

 N ICDRETV ;to store the selected code information

 N ICDPARAM ;  to set your application specific prompts and messages

 N ICDCSYS ;coding system "ICD9" or ICD10"

 N ICDOUT ;to return all available information about the selected code

 ;settings:

 D SETPARAM(.ICDPARAM) ;edit the SETPARAM subroutine below to set your application specific prompts

 ;starting demo loop

 S ICDQUIT=0 F  Q:ICDQUIT=1  D

 . S ICDRETV=0,ICDOUT=""

 . W @IOF ;reset the screen

 . ;prompt for the date of interest

 . I $G(ICDDATE)="" D EFFDATE^ICDDRGM G EXIT:$D(DUOUT),EXIT:$D(DTOUT)

 . I $G(ICDDATE)'="" S ICDDT=ICDDATE

 . ;prompt for "try again" with "No" as default if ^ or null entered for the date or if timed out

 . I ICDDT'>0 S:$$QUESTION(2,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q

 . ;determine coding system based on the date of interest 

 . S ICDCSYS=$$ICDSYSDG(ICDDT)

 . ;set default response for your prompt

 . S ICDDFLT=""

 . ;If coding system is ICD9 change ICDDT and prompt for ICD-10 so that user can query ICD-10 codes before ICD-10 implementaiton date

 . I ICDCSYS=1 S ICDCSYS=30 S ICDDT=$$IMPDATE^LEXU("10D")

 . ;run either ICD9 or ICD10 prompt/search/select logic

 . ;ICD9 (1 is a pointer to the ICD-9-CM diagnosis system entry in the new file #80.4 )

 . I ICDCSYS=1 S ICDRETV=$$DIAG9(ICDDT,ICDDFLT,.ICDOUT,.ICDPARAM) I ICDRETV=-2 S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q

 . ;ICD10 (30 is a pointer to the ICD-10-CM diagnosis system entry in the new file #80.4 )

 . I ICDCSYS=30 S ICDRETV=$$DIAG10(ICDDT,ICDDFLT,.ICDPARAM)

 . ;display information about the code selected (for demo purposes)

 . I ICDRETV>0 W !,"SELECTED: " D CODEINFO(ICDRETV) S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q

 . ;no changes to the default value 

 . I ICDRETV=-5 S:$$QUESTION(1,ICDPARAM("NO CHANGES"))'=1 ICDQUIT=1 Q

 . ;if no data found

 . I ICDRETV="" W !!,ICDPARAM("NO DATA FOUND") S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q

 . ;in ICD10 if the user answered NO for the question "Do you wish to continue(Y/N)?"

 . I ICDRETV=-4 S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q

 . ;no data or was aborted 

 . I ICDRETV=-2 S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q

 . ;if exit due to ^ in the ICD Diagnosis code prompt 

 . I ICDRETV=-3 S:$$QUESTION(2,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q

 . ;if no data found

 . I ICDRETV=-1 S:$$QUESTION(2,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q

 . ; if continue search

 . I ICDRETV=-6 W !,ICDPARAM("DELETE IT"),! S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q

 Q

 ;//---------

 ;The entry point for ICD-10 diagnosis search functionality

 ;can be called from applications directly

 ;input parameters :

 ; ICDDT - date of interest, ICDDFLT - default values for hter search string (can be a code by default)

 ; ICDOUT - local array to return results (passed as a reference)

 ; ICDPARAM - parameters/string constants (see SETPARAM for details)

 ;returns ICD-10 code selected by the user:

 ;  IEN file #80;ICD code value^description

 ; results

 ; or -1 if invalid data(press enter), "" if not found, or -2 if time out, or -3 if ^ or ^^, or -4 in ICD10 if the usre answered NO for the question "Do you wish to continue(Y/N)?", or -5 if no changes to the default value

DIAG10(ICDDT,ICDDFLT,ICDPARAM) ;

 N ICDINP

 F  D  Q:ICDINP<0!($L($P(ICDINP,U,2))>1)

 . S ICDINP=$$SRCHSTR(ICDPARAM("SEARCH_PROMPT"),ICDPARAM("HELP ?"),ICDPARAM("HELP ??"),ICDDFLT)

 . I ICDINP'<0 I $L($P(ICDINP,U,2))'>1 W !,ICDPARAM("ENTER MORE") W:$L(ICDPARAM("ENTER MORE2"))>0 !,ICDPARAM("ENTER MORE2") ;user should enter at least 2 characters

 I ICDINP<0 Q ICDINP

 Q $$LEXICD10($P(ICDINP,U,2),ICDDT,.ICDPARAM)

 ;//---------

 ;The entry point for ICD-9 FileMan type (^DIC) diagnosis search functionality

 ;can be called from applications directly

 ;input parameters :

 ; ICDDT - date of interest, ICDDFLT - default values for hter search string (can be a code by default), ICDOUT - local array to return results(passed as a reference)

 ; ICDPARAM - parameters/string constants (see SETPARAM for details)

 ;returns ICD-9 code selected by the user:

 ;  IEN file #80;ICD code value^description, -2 no data or was aborted, -1 if timeout, -3 was aborted, -5 if no changes to the default value

DIAG9(ICDDT,ICDDFLT,ICDOUT,ICDPARAM) ;

 N ICDINP,ICDRETV

 S ICDINP=$$SRCHSTR(ICDPARAM("SEARCH_PROMPT"),"","",ICDDFLT)

 I ICDINP=-1 Q -1  ;enter

 I ICDINP=-3 Q -1  ;^ or ^^

 I ICDINP=-2 Q -2  ;timeout or not found

 I ICDINP=-1!(ICDINP=-3) Q -2

 I ICDINP<0 Q +ICDINP

 S ICDRETV=$$ICD9($P(ICDINP,U,2),ICDDT,.ICDOUT)

 I ICDRETV=-1 Q -2

 Q ICDRETV

 ;--------------

 ;The entry point for ICD-10 diagnosis search functionality

 ;can be called from applications directly

 ; Supported ICR 5681 ($$DIAGSRCH^LEX10CS)

 ;input parameters :

 ; ICDTXT - search string, ICDDATE - date of interest, ICDPAR - array with text messages and other string constants

 ;returns ICD-10 code selected by the user:

 ;  IEN file #80;ICD code value^description, "" if not found, -1 if exit : ^ or ^^, -2 if continue searching

LEXICD10(ICDTXT,ICDDATE,ICDPAR) ; ICD-10 Search

 N ICDLVTXT

 ;parameters check

 S ICDDATE=+$G(ICDDATE)

 I ICDDATE'?7N Q -1

 S ICDTXT=$G(ICDTXT)

 Q:'$L(ICDTXT) -1

 N ICDNUMB

 S ICDNUMB=$$FREQ^LEXU(ICDTXT)

 I ICDNUMB>$$MAX^LEXU(30) D  I $$QUESTION("N",ICDPARAM("WISH CONTINUE"))'=1 Q -4

 . W !

 . D FORMWRIT(ICDPAR("EXCEEDS MESSAGE1")_ICDTXT_ICDPAR("EXCEEDS MESSAGE2")_ICDNUMB_ICDPAR("EXCEEDS MESSAGE3")_ICDTXT_""".",0)

 . D FORMWRIT("",2)

 . W !

 ;new and set variables

 N DIROUT,DUOUT,DTOUT,ICDEXIT,ICDICDNT

 N ICDRETV,ICDXX,ICDLEVEL

 S ICDRETV=""

 S ICDEXIT=0

 S ICDLEVEL=1,ICDLVTXT(ICDLEVEL)=ICDTXT ;level 1 stores the original search string

 ; main loop

 F  Q:ICDEXIT>0  D

 .K ICDICDY

 .;W !,"Level #: ",ICDLEVEL,", search string: ",ICDLVTXT(ICDLEVEL)

 .;get the search string from the current level and call LEX API

 .S ICDICDY=$$DIAGSRCH^LEX10CS(ICDLVTXT(ICDLEVEL),.ICDICDY,ICDDATE,30)

 .S:$O(ICDICDY(" "),-1)>0 ICDICDY=+ICDICDY

 .; Nothing found

 .I +ICDICDY'>0 S ICDEXIT=1 S ICDXX=-1 Q

 .; display the list of items and ask the user to select the item from the list

 .S ICDXX=$$SEL^ICDSELDS(.ICDICDY,8)

 .; if ^ was entered 

 .;   if this is on the top level then quit 

 .I ICDXX=-2,ICDLEVEL'>1 S ICDRETV=-1 S ICDEXIT=1 Q

 .;   if lower level then go one level up

 .I ICDXX=-2,ICDLEVEL>1 S:ICDLEVEL>1 ICDLEVEL=ICDLEVEL-1 Q

 .; If timeout, or not selected, or ^^ then quit

 .I ICDXX=-1 S ICDRETV=-1 S ICDEXIT=1 Q

 .; if Code Found and Selected by the user save selection in ICDRETV and quit

 .I $P(ICDXX,";")'="99:CAT" S ICDRETV=ICDXX S ICDEXIT=1 Q

 .; If Category Found and Selected by the user:  

 .;  go to the next inner level

 .;  change level number 

 .S ICDLEVEL=ICDLEVEL+1

 .;  set the new level with the new search string

 .;  and repeat 

 .S ICDLVTXT(ICDLEVEL)=$P($P($G(ICDXX),"^"),";",2)

 Q ICDRETV

 ;----------

 ;ICD-9 lookup (FileMan lookup)

 ;Supported ICR 5773 (FileMan lookup for files #80 nad #80.1)

 ;Supported ICR 5699 ($$ICDDATA^ICDXCODE)

 ;input parameters :

 ; ICDSRCH - search string 

 ; ICDICDT - date of interest  

 ; ICDOUT - local array to return detailed info (passed as a reference)

 ;returns ICD-9 code selected by the user:

 ;  IEN file #80;ICD code value^description

 ; or "" if not found, -1 if exit : ^ or ^^, -2 if continue search

 ;the array ICDOUT returns details if the return value >0, here is an example: 

 ; ICDOUT="6065^814.14", ICDOUT(0)=814.14, ICDOUT(0,0)=814.14, ICDOUT(0,1)="6065^814.14^^FX PISIFORM-OPEN^^8^^1^^1^^^0^^^^2781001^^1^1"

 ; ICDOUT(0,2)="OPEN FRACTURE OF PISIFORM BONE OF WRIST"

 ;Note: this API is not silent because the ICD lookup is not silent

ICD9(ICDSRCH,ICDICDT,ICDOUT) ;

 N ICDKEY,X,Y,DIC,ICDCDS

 ;KEY must be newed as ICD lookup code doesn't kill it

 S DIC="^ICD9(",DIC(0)="EQXZ"

 S ICDCDS="ICD9"

 ;note: you must use Y for the 2nd parameter of $$ICDDATA^ICDXCODE

 S DIC("S")="I $P($$ICDDATA^ICDXCODE(ICDCDS,Y,ICDICDT),U,10)=1"

 ; both X and Y should be set to the search string

 S (X,Y)=ICDSRCH

 D ^DIC

 M ICDOUT=Y

 I $G(Y) Q $S(Y=-1:-1,1:+Y_";"_$P(Y,U,2)_U_$G(Y(0,2)))

 Q X

 ;---------

 ; Look-up help

 ; Look-up help for ?

INPHLP ;

 I $G(X)["???" D INPHLP3 Q

 I $G(X)["??" D INPHLP2 Q

 W !," Enter code or ""text"" for more information." Q

 Q

 ;-----------

 ; Look-up help for ??

INPHLP2 ;

 W !," Enter a ""free text"" term or part of a term such as ""femur fracture"""

 W !!," or "

 W !!," Enter a ""classification code"" (ICD/CPT, etc.) to find the single term"

 W !," associated with the code"

 W !!," or "

 W !!," Enter a ""partial code"". Include the decimal when a search criterion"

 W !," includes 3 characters or more for code searches."

 Q

 ;--------

 ; Look-up help for ???

INPHLP3 ;

 W !," Number of Code Matches"

 W !," ----------------------"

 W !!," The ICD-10 Diagnosis Code search will show the user the number of matches"

 W !," found, indicate if additional characters in ICD code exist, and the number"

 W !," of codes within the category or subcategory that are available for selection."

 W !," For example:"

 W !!," 14 matches found"

 W !!," M91. - Juvenile osteochondrosis of hip and pelvis (19)"

 W !!," This indicates that 14 unique matches or matching groups have been found"

 W !," and will be displayed."

 W !!," M91. - the ""-"" indicates that there are additional characters that specify"

 W !," unique ICD-10 codes available."

 W !!," (19) Indicates that there are 19 additional ICD-10 codes in the M91 ""family"""

 W !," that are possible selections."

 Q

 ;--------

 ;prompt the user for a date of interest 

 ;input parameters :

 ; ICDPRMT - prompt

 ;returns YYYMMDD, or -1 if invalid date, or -2 if time out, or -3 if ^

ASKDATE(ICDPRMT) ;

 N %DT,DIROUT,DUOUT,DTOUT

 S %DT="AEX",%DT("A")=$G(ICDPRMT,"Enter a date: ")

 D ^%DT

 Q:Y<0 -1

 Q:$D(DTOUT) -2

 Q:X="^" -3

 Q (+Y)

 ;--------

 ;ask YES/NO questions

 ;input parameters :

 ; ICDDFLT- 0/null- not default, 1- yes, 2 -no

 ; ICDPROM - prompt string

 ;returns 2 - no, 1 -yes, 0 - no answer

QUESTION(ICDDFLT,ICDPROM) ;

 W:$L($G(ICDPROM)) !,ICDPROM

 S %=$G(ICDDFLT,2)

 D YN^DICN

 Q:%Y["^" -3

 I %=2!(%=1) Q %

 Q -2

 ;------------

 ;get search string

 ;input parameters :

 ; ICDPRMT prompt text

 ; ICDHLP1 "?" help text

 ; ICDHLP2 "??" help text

 ; ICDDFLT- default response

 ;returns piece1 ^ piece 2

 ; piece1:

 ; 0 if normal input, or -1 if invalid data, or -2 if time out, or -3 if ^

 ; piece2: string entered by the user

 ; or -5 if user accepts default value then no need to validate it, or -6 if user enters "@"

SRCHSTR(ICDPRMT,ICDHLP1,ICDHLP2,ICDDFLT) ;

 N DIR

 S DIR("A")=ICDPRMT

 S:($G(ICDHLP1)]"") DIR("?")=ICDHLP1

 S:($G(ICDHLP1)]"") DIR("??")=ICDHLP2

 I $L($G(ICDDFLT)) S DIR("B")=ICDDFLT

 S DIR(0)="FAO^0:245"

 D ^DIR

 Q:$D(DTOUT) -2

 Q:$D(DUOUT) -3

 Q:X="@" -6 ;quit if user entered "@" and handle deletion case in your application 

 Q:Y["^" -3

 Q:Y="" -1

 Q 0_U_Y

 ;----------

 ;Determines and returns ACTIVE coding system for DIAGNOSES based on date of interest 

 ;input parameters :

 ; ICDICDD - date of interest

 ; if date of interest is null, today's date will be assumed

 ;returns coding system  

 ; as a pointer to the ICD CODING SYSTEM file #80.4 (supported ICR 5780) 

 ; 30  if ICD-10-CM is active system, 1   if ICD-9-CM is active system

ICDSYSDG(ICDICDD) ; 

 N ICDIMPDT

 S ICDICDD=$S(ICDICDD<0!($L(+ICDICDD)'=7):DT,1:+$G(ICDICDD))

 S ICDIMPDT=$$IMPDATE^LEXU("10D")

 Q $S(ICDICDD'<ICDIMPDT:30,1:1)

 ;

 ;set parameters

 ;edit these hardcoded strings that are used for prompts, messages and so on to adjust them to your applicaion's needs

 ;input parameters 

 ; ICDPAR - local array to sets and store string constants for your messages and prompts 

SETPARAM(ICDPAR) ;

 S ICDPAR("ASKDATE")="Effective Date: "

 S ICDPAR("SEARCH_PROMPT")="ICD-10 Diagnosis Code or a Code Fragment: "

 S ICDPAR("HELP ?")="^D INPHLP^ICDDSLK"

 S ICDPAR("HELP ??")="^D INPHLP2^ICDDSLK"

 S ICDPAR("NO DATA FOUND")="  No data found"

 S ICDPAR("EXITING")="  Exiting"

 S ICDPAR("TRY LATER")="  Try again later"

 S ICDPAR("NO DATA SELECTED")="  No data selected"

 S ICDPAR("TRY ANOTHER")="Try another"

 S ICDPAR("WISH CONTINUE")="Do you wish to continue (Y/N)"

 S ICDPAR("EXCEEDS MESSAGE1")="Searching for """

 S ICDPAR("EXCEEDS MESSAGE2")=""" requires inspecting "

 S ICDPAR("EXCEEDS MESSAGE3")=" records to determine if they match the search criteria.  This could take quite some time.  Suggest refining the search by further specifying """

 S ICDPAR("NO CHANGES")=" No changes made"

 S ICDPAR("DELETE IT")=" User has requested deletion of the code"

 S ICDPAR("ENTER MORE")=" Please enter at least the first two characters of the ICD-10 code or code"

 S ICDPAR("ENTER MORE2")=" description to start the search."

 Q

 ;a wrapper for ^DIWP

 ;accumulates a text and then writes it to the device

 ;input parameters :

 ; X - text

 ; ICDMODE:

 ;  0 - start, 1 - accumulate, 2 - write

 ;example:

 ;D FORMWRIT^ICDDSLK("this API is a wrapper for ^DIWP, it accumulates a text and then writes it to the device, you can use it in your application code",0)

 ;D FORMWRIT^ICDDSLK("some more text ",1)

 ;D FORMWRIT^ICDDSLK("",2)

FORMWRIT(X,ICDMODE) ;

 N ICDLI1

 ;if "start" mode

 I ICDMODE=0 K ^UTILITY($J,"W")

 S DIWL=1,DIWR=79

 I $L(X)>0 D ^DIWP

 ;if "write" mode

 I ICDMODE=2 D

 . S ICDLI1=0 F  S ICDLI1=$O(^UTILITY($J,"W",1,ICDLI1)) Q:+ICDLI1=0  W !,$G(^UTILITY($J,"W",1,ICDLI1,0))

 . K ^UTILITY($J,"W")

 Q

 ;Initialize variables if you need , your application most likely already has this

INITVARS ;

 D HOME^%ZIS

 S:$G(DT)=0 DT=$$DT^XLFDT

 Q

 ;press any key (used for demo)

PRESSKEY ;

 R !!,"Press any key to continue.",ICDKEY:DTIME

 Q

 ;display code info (used for demo)

CODEINFO(ICDXX2) ; Write Output

 N ICDKEY,ICDTMP

 S ICDTMP=$$ICDDX^ICDEX($P($P(ICDXX2,";",2),U,1),$G(ICDDT),30,"E")

 S $P(ICDTMP,"^",3)=$TR($P(ICDTMP,"^",3),";","")

 W !!,$P($P(ICDXX2,";",2),U,1),?15,$P($P(ICDXX2,";",2),U,2),!  ;add printing of descript disclaimer msg

 I '$P(ICDTMP,U,10) W "   **CODE INACTIVE" I $P(ICDTMP,U,12)'="" S Y=$P(ICDTMP,U,12) D DD^%DT W " AS OF   ",Y," **",!

 Q

 ; Clean up environment and quit

EXIT ;

 K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 Q

 ;