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. 
  1. ICDDSLK ;KUM/SJA/SS - ICD-10 DIAGNOSIS CODE LOOK UP;12-06-11
  1.  ;;18.0;DRG Grouper;**64**;Oct 20, 2000;Build 103
  1.  ;
  1.  ; ICDDATE is EFFECTIVE DATE that passed from Calling routine
  1. EN ; ENTRY
  1.  D INITVARS ;set standards variables, you might not need this if it was already done in your application  
  1.  N ICDQUIT ; to manage demo loop
  1.  N ICDRETV ;to store the selected code information
  1.  N ICDPARAM ;  to set your application specific prompts and messages
  1.  N ICDCSYS ;coding system "ICD9" or ICD10"
  1.  N ICDOUT ;to return all available information about the selected code
  1.  ;settings:
  1.  D SETPARAM(.ICDPARAM) ;edit the SETPARAM subroutine below to set your application specific prompts
  1.  ;starting demo loop
  1.  S ICDQUIT=0 F  Q:ICDQUIT=1  D
  1.  . S ICDRETV=0,ICDOUT=""
  1.  . W @IOF ;reset the screen
  1.  . ;prompt for the date of interest
  1.  . I $G(ICDDATE)="" D EFFDATE^ICDDRGM G EXIT:$D(DUOUT),EXIT:$D(DTOUT)
  1.  . I $G(ICDDATE)'="" S ICDDT=ICDDATE
  1.  . ;prompt for "try again" with "No" as default if ^ or null entered for the date or if timed out
  1.  . I ICDDT'>0 S:$$QUESTION(2,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q
  1.  . ;determine coding system based on the date of interest 
  1.  . S ICDCSYS=$$ICDSYSDG(ICDDT)
  1.  . ;set default response for your prompt
  1.  . S ICDDFLT=""
  1.  . ;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
  1.  . I ICDCSYS=1 S ICDCSYS=30 S ICDDT=$$IMPDATE^LEXU("10D")
  1.  . ;run either ICD9 or ICD10 prompt/search/select logic
  1.  . ;ICD9 (1 is a pointer to the ICD-9-CM diagnosis system entry in the new file #80.4 )
  1.  . I ICDCSYS=1 S ICDRETV=$$DIAG9(ICDDT,ICDDFLT,.ICDOUT,.ICDPARAM) I ICDRETV=-2 S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q
  1.  . ;ICD10 (30 is a pointer to the ICD-10-CM diagnosis system entry in the new file #80.4 )
  1.  . I ICDCSYS=30 S ICDRETV=$$DIAG10(ICDDT,ICDDFLT,.ICDPARAM)
  1.  . ;display information about the code selected (for demo purposes)
  1.  . I ICDRETV>0 W !,"SELECTED: " D CODEINFO(ICDRETV) S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q
  1.  . ;no changes to the default value 
  1.  . I ICDRETV=-5 S:$$QUESTION(1,ICDPARAM("NO CHANGES"))'=1 ICDQUIT=1 Q
  1.  . ;if no data found
  1.  . I ICDRETV="" W !!,ICDPARAM("NO DATA FOUND") S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q
  1.  . ;in ICD10 if the user answered NO for the question "Do you wish to continue(Y/N)?"
  1.  . I ICDRETV=-4 S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q
  1.  . ;no data or was aborted 
  1.  . I ICDRETV=-2 S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q
  1.  . ;if exit due to ^ in the ICD Diagnosis code prompt 
  1.  . I ICDRETV=-3 S:$$QUESTION(2,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q
  1.  . ;if no data found
  1.  . I ICDRETV=-1 S:$$QUESTION(2,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q
  1.  . ; if continue search
  1.  . I ICDRETV=-6 W !,ICDPARAM("DELETE IT"),! S:$$QUESTION(1,ICDPARAM("TRY ANOTHER"))'=1 ICDQUIT=1 Q
  1.  Q
  1.  ;//---------
  1.  ;The entry point for ICD-10 diagnosis search functionality
  1.  ;can be called from applications directly
  1.  ;input parameters :
  1.  ; ICDDT - date of interest, ICDDFLT - default values for hter search string (can be a code by default)
  1.  ; ICDOUT - local array to return results (passed as a reference)
  1.  ; ICDPARAM - parameters/string constants (see SETPARAM for details)
  1.  ;returns ICD-10 code selected by the user:
  1.  ;  IEN file #80;ICD code value^description
  1.  ; results
  1.  ; 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
  1. DIAG10(ICDDT,ICDDFLT,ICDPARAM) ;
  1.  N ICDINP
  1.  F  D  Q:ICDINP<0!($L($P(ICDINP,U,2))>1)
  1.  . S ICDINP=$$SRCHSTR(ICDPARAM("SEARCH_PROMPT"),ICDPARAM("HELP ?"),ICDPARAM("HELP ??"),ICDDFLT)
  1.  . 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
  1.  I ICDINP<0 Q ICDINP
  1.  Q $$LEXICD10($P(ICDINP,U,2),ICDDT,.ICDPARAM)
  1.  ;//---------
  1.  ;The entry point for ICD-9 FileMan type (^DIC) diagnosis search functionality
  1.  ;can be called from applications directly
  1.  ;input parameters :
  1.  ; 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)
  1.  ; ICDPARAM - parameters/string constants (see SETPARAM for details)
  1.  ;returns ICD-9 code selected by the user:
  1.  ;  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
  1. DIAG9(ICDDT,ICDDFLT,ICDOUT,ICDPARAM) ;
  1.  N ICDINP,ICDRETV
  1.  S ICDINP=$$SRCHSTR(ICDPARAM("SEARCH_PROMPT"),"","",ICDDFLT)
  1.  I ICDINP=-1 Q -1  ;enter
  1.  I ICDINP=-3 Q -1  ;^ or ^^
  1.  I ICDINP=-2 Q -2  ;timeout or not found
  1.  I ICDINP=-1!(ICDINP=-3) Q -2
  1.  I ICDINP<0 Q +ICDINP
  1.  S ICDRETV=$$ICD9($P(ICDINP,U,2),ICDDT,.ICDOUT)
  1.  I ICDRETV=-1 Q -2
  1.  Q ICDRETV
  1.  ;--------------
  1.  ;The entry point for ICD-10 diagnosis search functionality
  1.  ;can be called from applications directly
  1.  ; Supported ICR 5681 ($$DIAGSRCH^LEX10CS)
  1.  ;input parameters :
  1.  ; ICDTXT - search string, ICDDATE - date of interest, ICDPAR - array with text messages and other string constants
  1.  ;returns ICD-10 code selected by the user:
  1.  ;  IEN file #80;ICD code value^description, "" if not found, -1 if exit : ^ or ^^, -2 if continue searching
  1. LEXICD10(ICDTXT,ICDDATE,ICDPAR) ; ICD-10 Search
  1.  N ICDLVTXT
  1.  ;parameters check
  1.  S ICDDATE=+$G(ICDDATE)
  1.  I ICDDATE'?7N Q -1
  1.  S ICDTXT=$G(ICDTXT)
  1.  Q:'$L(ICDTXT) -1
  1.  N ICDNUMB
  1.  S ICDNUMB=$$FREQ^LEXU(ICDTXT)
  1.  I ICDNUMB>$$MAX^LEXU(30) D  I $$QUESTION("N",ICDPARAM("WISH CONTINUE"))'=1 Q -4
  1.  . W !
  1.  . D FORMWRIT(ICDPAR("EXCEEDS MESSAGE1")_ICDTXT_ICDPAR("EXCEEDS MESSAGE2")_ICDNUMB_ICDPAR("EXCEEDS MESSAGE3")_ICDTXT_""".",0)
  1.  . D FORMWRIT("",2)
  1.  . W !
  1.  ;new and set variables
  1.  N DIROUT,DUOUT,DTOUT,ICDEXIT,ICDICDNT
  1.  N ICDRETV,ICDXX,ICDLEVEL
  1.  S ICDRETV=""
  1.  S ICDEXIT=0
  1.  S ICDLEVEL=1,ICDLVTXT(ICDLEVEL)=ICDTXT ;level 1 stores the original search string
  1.  ; main loop
  1.  F  Q:ICDEXIT>0  D
  1.  .K ICDICDY
  1.  .;W !,"Level #: ",ICDLEVEL,", search string: ",ICDLVTXT(ICDLEVEL)
  1.  .;get the search string from the current level and call LEX API
  1.  .S ICDICDY=$$DIAGSRCH^LEX10CS(ICDLVTXT(ICDLEVEL),.ICDICDY,ICDDATE,30)
  1.  .S:$O(ICDICDY(" "),-1)>0 ICDICDY=+ICDICDY
  1.  .; Nothing found
  1.  .I +ICDICDY'>0 S ICDEXIT=1 S ICDXX=-1 Q
  1.  .; display the list of items and ask the user to select the item from the list
  1.  .S ICDXX=$$SEL^ICDSELDS(.ICDICDY,8)
  1.  .; if ^ was entered 
  1.  .;   if this is on the top level then quit 
  1.  .I ICDXX=-2,ICDLEVEL'>1 S ICDRETV=-1 S ICDEXIT=1 Q
  1.  .;   if lower level then go one level up
  1.  .I ICDXX=-2,ICDLEVEL>1 S:ICDLEVEL>1 ICDLEVEL=ICDLEVEL-1 Q
  1.  .; If timeout, or not selected, or ^^ then quit
  1.  .I ICDXX=-1 S ICDRETV=-1 S ICDEXIT=1 Q
  1.  .; if Code Found and Selected by the user save selection in ICDRETV and quit
  1.  .I $P(ICDXX,";")'="99:CAT" S ICDRETV=ICDXX S ICDEXIT=1 Q
  1.  .; If Category Found and Selected by the user:  
  1.  .;  go to the next inner level
  1.  .;  change level number 
  1.  .S ICDLEVEL=ICDLEVEL+1
  1.  .;  set the new level with the new search string
  1.  .;  and repeat 
  1.  .S ICDLVTXT(ICDLEVEL)=$P($P($G(ICDXX),"^"),";",2)
  1.  Q ICDRETV
  1.  ;----------
  1.  ;ICD-9 lookup (FileMan lookup)
  1.  ;Supported ICR 5773 (FileMan lookup for files #80 nad #80.1)
  1.  ;Supported ICR 5699 ($$ICDDATA^ICDXCODE)
  1.  ;input parameters :
  1.  ; ICDSRCH - search string 
  1.  ; ICDICDT - date of interest  
  1.  ; ICDOUT - local array to return detailed info (passed as a reference)
  1.  ;returns ICD-9 code selected by the user:
  1.  ;  IEN file #80;ICD code value^description
  1.  ; or "" if not found, -1 if exit : ^ or ^^, -2 if continue search
  1.  ;the array ICDOUT returns details if the return value >0, here is an example: 
  1.  ; 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"
  1.  ; ICDOUT(0,2)="OPEN FRACTURE OF PISIFORM BONE OF WRIST"
  1.  ;Note: this API is not silent because the ICD lookup is not silent
  1. ICD9(ICDSRCH,ICDICDT,ICDOUT) ;
  1.  N ICDKEY,X,Y,DIC,ICDCDS
  1.  ;KEY must be newed as ICD lookup code doesn't kill it
  1.  S DIC="^ICD9(",DIC(0)="EQXZ"
  1.  S ICDCDS="ICD9"
  1.  ;note: you must use Y for the 2nd parameter of $$ICDDATA^ICDXCODE
  1.  S DIC("S")="I $P($$ICDDATA^ICDXCODE(ICDCDS,Y,ICDICDT),U,10)=1"
  1.  ; both X and Y should be set to the search string
  1.  S (X,Y)=ICDSRCH
  1.  D ^DIC
  1.  M ICDOUT=Y
  1.  I $G(Y) Q $S(Y=-1:-1,1:+Y_";"_$P(Y,U,2)_U_$G(Y(0,2)))
  1.  Q X
  1.  ;---------
  1.  ; Look-up help
  1.  ; Look-up help for ?
  1. INPHLP ;
  1.  I $G(X)["???" D INPHLP3 Q
  1.  I $G(X)["??" D INPHLP2 Q
  1.  W !," Enter code or ""text"" for more information." Q
  1.  Q
  1.  ;-----------
  1.  ; Look-up help for ??
  1. INPHLP2 ;
  1.  W !," Enter a ""free text"" term or part of a term such as ""femur fracture"""
  1.  W !!," or "
  1.  W !!," Enter a ""classification code"" (ICD/CPT, etc.) to find the single term"
  1.  W !," associated with the code"
  1.  W !!," or "
  1.  W !!," Enter a ""partial code"". Include the decimal when a search criterion"
  1.  W !," includes 3 characters or more for code searches."
  1.  Q
  1.  ;--------
  1.  ; Look-up help for ???
  1. INPHLP3 ;
  1.  W !," Number of Code Matches"
  1.  W !," ----------------------"
  1.  W !!," The ICD-10 Diagnosis Code search will show the user the number of matches"
  1.  W !," found, indicate if additional characters in ICD code exist, and the number"
  1.  W !," of codes within the category or subcategory that are available for selection."
  1.  W !," For example:"
  1.  W !!," 14 matches found"
  1.  W !!," M91. - Juvenile osteochondrosis of hip and pelvis (19)"
  1.  W !!," This indicates that 14 unique matches or matching groups have been found"
  1.  W !," and will be displayed."
  1.  W !!," M91. - the ""-"" indicates that there are additional characters that specify"
  1.  W !," unique ICD-10 codes available."
  1.  W !!," (19) Indicates that there are 19 additional ICD-10 codes in the M91 ""family"""
  1.  W !," that are possible selections."
  1.  Q
  1.  ;--------
  1.  ;prompt the user for a date of interest 
  1.  ;input parameters :
  1.  ; ICDPRMT - prompt
  1.  ;returns YYYMMDD, or -1 if invalid date, or -2 if time out, or -3 if ^
  1. ASKDATE(ICDPRMT) ;
  1.  N %DT,DIROUT,DUOUT,DTOUT
  1.  S %DT="AEX",%DT("A")=$G(ICDPRMT,"Enter a date: ")
  1.  D ^%DT
  1.  Q:Y<0 -1
  1.  Q:$D(DTOUT) -2
  1.  Q:X="^" -3
  1.  Q (+Y)
  1.  ;--------
  1.  ;ask YES/NO questions
  1.  ;input parameters :
  1.  ; ICDDFLT- 0/null- not default, 1- yes, 2 -no
  1.  ; ICDPROM - prompt string
  1.  ;returns 2 - no, 1 -yes, 0 - no answer
  1. QUESTION(ICDDFLT,ICDPROM) ;
  1.  W:$L($G(ICDPROM)) !,ICDPROM
  1.  S %=$G(ICDDFLT,2)
  1.  D YN^DICN
  1.  Q:%Y["^" -3
  1.  I %=2!(%=1) Q %
  1.  Q -2
  1.  ;------------
  1.  ;get search string
  1.  ;input parameters :
  1.  ; ICDPRMT prompt text
  1.  ; ICDHLP1 "?" help text
  1.  ; ICDHLP2 "??" help text
  1.  ; ICDDFLT- default response
  1.  ;returns piece1 ^ piece 2
  1.  ; piece1:
  1.  ; 0 if normal input, or -1 if invalid data, or -2 if time out, or -3 if ^
  1.  ; piece2: string entered by the user
  1.  ; or -5 if user accepts default value then no need to validate it, or -6 if user enters "@"
  1. SRCHSTR(ICDPRMT,ICDHLP1,ICDHLP2,ICDDFLT) ;
  1.  N DIR
  1.  S DIR("A")=ICDPRMT
  1.  S:($G(ICDHLP1)]"") DIR("?")=ICDHLP1
  1.  S:($G(ICDHLP1)]"") DIR("??")=ICDHLP2
  1.  I $L($G(ICDDFLT)) S DIR("B")=ICDDFLT
  1.  S DIR(0)="FAO^0:245"
  1.  D ^DIR
  1.  Q:$D(DTOUT) -2
  1.  Q:$D(DUOUT) -3
  1.  Q:X="@" -6 ;quit if user entered "@" and handle deletion case in your application 
  1.  Q:Y["^" -3
  1.  Q:Y="" -1
  1.  Q 0_U_Y
  1.  ;----------
  1.  ;Determines and returns ACTIVE coding system for DIAGNOSES based on date of interest 
  1.  ;input parameters :
  1.  ; ICDICDD - date of interest
  1.  ; if date of interest is null, today's date will be assumed
  1.  ;returns coding system  
  1.  ; as a pointer to the ICD CODING SYSTEM file #80.4 (supported ICR 5780) 
  1.  ; 30  if ICD-10-CM is active system, 1   if ICD-9-CM is active system
  1. ICDSYSDG(ICDICDD) ; 
  1.  N ICDIMPDT
  1.  S ICDICDD=$S(ICDICDD<0!($L(+ICDICDD)'=7):DT,1:+$G(ICDICDD))
  1.  S ICDIMPDT=$$IMPDATE^LEXU("10D")
  1.  Q $S(ICDICDD'<ICDIMPDT:30,1:1)
  1.  ;
  1.  ;set parameters
  1.  ;edit these hardcoded strings that are used for prompts, messages and so on to adjust them to your applicaion's needs
  1.  ;input parameters 
  1.  ; ICDPAR - local array to sets and store string constants for your messages and prompts 
  1. SETPARAM(ICDPAR) ;
  1.  S ICDPAR("ASKDATE")="Effective Date: "
  1.  S ICDPAR("SEARCH_PROMPT")="ICD-10 Diagnosis Code or a Code Fragment: "
  1.  S ICDPAR("HELP ?")="^D INPHLP^ICDDSLK"
  1.  S ICDPAR("HELP ??")="^D INPHLP2^ICDDSLK"
  1.  S ICDPAR("NO DATA FOUND")="  No data found"
  1.  S ICDPAR("EXITING")="  Exiting"
  1.  S ICDPAR("TRY LATER")="  Try again later"
  1.  S ICDPAR("NO DATA SELECTED")="  No data selected"
  1.  S ICDPAR("TRY ANOTHER")="Try another"
  1.  S ICDPAR("WISH CONTINUE")="Do you wish to continue (Y/N)"
  1.  S ICDPAR("EXCEEDS MESSAGE1")="Searching for """
  1.  S ICDPAR("EXCEEDS MESSAGE2")=""" requires inspecting "
  1.  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 """
  1.  S ICDPAR("NO CHANGES")=" No changes made"
  1.  S ICDPAR("DELETE IT")=" User has requested deletion of the code"
  1.  S ICDPAR("ENTER MORE")=" Please enter at least the first two characters of the ICD-10 code or code"
  1.  S ICDPAR("ENTER MORE2")=" description to start the search."
  1.  Q
  1.  ;a wrapper for ^DIWP
  1.  ;accumulates a text and then writes it to the device
  1.  ;input parameters :
  1.  ; X - text
  1.  ; ICDMODE:
  1.  ;  0 - start, 1 - accumulate, 2 - write
  1.  ;example:
  1.  ;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)
  1.  ;D FORMWRIT^ICDDSLK("some more text ",1)
  1.  ;D FORMWRIT^ICDDSLK("",2)
  1. FORMWRIT(X,ICDMODE) ;
  1.  N ICDLI1
  1.  ;if "start" mode
  1.  I ICDMODE=0 K ^UTILITY($J,"W")
  1.  S DIWL=1,DIWR=79
  1.  I $L(X)>0 D ^DIWP
  1.  ;if "write" mode
  1.  I ICDMODE=2 D
  1.  . S ICDLI1=0 F  S ICDLI1=$O(^UTILITY($J,"W",1,ICDLI1)) Q:+ICDLI1=0  W !,$G(^UTILITY($J,"W",1,ICDLI1,0))
  1.  . K ^UTILITY($J,"W")
  1.  Q
  1.  ;Initialize variables if you need , your application most likely already has this
  1. INITVARS ;
  1.  D HOME^%ZIS
  1.  S:$G(DT)=0 DT=$$DT^XLFDT
  1.  Q
  1.  ;press any key (used for demo)
  1. PRESSKEY ;
  1.  R !!,"Press any key to continue.",ICDKEY:DTIME
  1.  Q
  1.  ;display code info (used for demo)
  1. CODEINFO(ICDXX2) ; Write Output
  1.  N ICDKEY,ICDTMP
  1.  S ICDTMP=$$ICDDX^ICDEX($P($P(ICDXX2,";",2),U,1),$G(ICDDT),30,"E")
  1.  S $P(ICDTMP,"^",3)=$TR($P(ICDTMP,"^",3),";","")
  1.  W !!,$P($P(ICDXX2,";",2),U,1),?15,$P($P(ICDXX2,";",2),U,2),!  ;add printing of descript disclaimer msg
  1.  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," **",!
  1.  Q
  1.  ; Clean up environment and quit
  1. EXIT ;
  1.  K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  Q
  1.  ;