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

RMPOICD1.m

Go to the documentation of this file. 
  1. RMPOICD1 ;ALB/MGD - ICD-10 DIAGNOSIS CODE LOOK UP; 12-06-11
  1.  ;;3.0;PROSTHETICS;**168**;Feb 09, 1996;Build 43
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; Reference to $$DIAGSRCH^LEX10CS supported by ICR #5681
  1.  ; Reference to $$IMPDATE^LEXU     supported by ICR #5679
  1.  ; Reference to $$FREQ^LEXU        supported by ICR #5679 
  1.  ; Reference to $$MAX^LEXU         supported by ICR #5679
  1.  ; Reference to LS^ICDEX           supported by ICR #5747
  1.  ; Reference to CSI^ICDEX          supported by ICR #5747
  1.  ;
  1.  ; This routine is based on ^ICDLOOK
  1.  ;
  1. EN ;
  1.  D DEMO
  1.  Q
  1.  ;
  1.  ;this is a demo code,
  1.  ;in your applications you might need to use some or all of the code below,
  1.  ;see comments
  1. DEMO ;
  1.  D INITVARS ;set standards variables, you might not need this if it was already done in your application 
  1.  N RMPQUIT ; to manage demo loop
  1.  N RMPRETV ;to store the selected code information
  1.  N RMPPARAM ; to set your application specific prompts and messages
  1.  N RMPCSYS ;coding system "ICD9" or ICD10"
  1.  N RMPOUT ;to return all available information about the selected code
  1.  N RMPDFLT9 ;default ICD-9 value for demo
  1.  N RMPDFL10 ;default ICD-10 value for demo
  1.  ;settings:
  1.  D SETPARAM(.RMPPARAM) ;edit the SETPARAM subroutine below to set your application specific prompts
  1.  ;starting demo loop
  1.  S RMPQUIT=0 F  Q:RMPQUIT=1  D
  1.  . S RMPRETV=0,RMPOUT=""
  1.  . W @IOF ;reset the screen
  1.  . ;prompt for the date of interest
  1.  . S RMPDT=$$ASKDATE(RMPPARAM("ASKDATE"))
  1.  . I RMPDT=-1 S RMPQUIT=1 Q
  1.  . ;prompt for "try again" with "No" as default if ^ or null entered for the date or if timed out
  1.  . I RMPDT'>0 S:$$QUESTION(2,RMPPARAM("TRY ANOTHER"))'=1 RMPQUIT=1 Q
  1.  . ;determine coding system based on the date of interest 
  1.  . S RMPCSYS=$$ICDSYSDG(RMPDT)
  1.  . ;set default response for your prompt
  1.  . S RMPDFLT9=""
  1.  . S RMPDFL10=""
  1.  . ;run either ICD9 or ICD10 prompt/search/select logic
  1.  . ;ICD9 (1 is a pointer to the ICD-9 diagnosis system entry in the new file #80.4 )
  1.  . I RMPCSYS=1 S RMPRETV=$$DIAG9(RMPDT,RMPDFLT9,.RMPOUT,.RMPPARAM) I RMPRETV=-2 S:$$QUESTION(1,RMPPARAM("TRY ANOTHER"))'=1 RMPQUIT=1 Q
  1.  . ;ICD10 (30 is a pointer to the ICD-10 diagnosis system entry in the new file #80.4 )
  1.  . I RMPCSYS=30 S RMPRETV=$$DIAG10(RMPDT,RMPDFL10,.RMPPARAM)
  1.  . ;display information about the code selected (for demo purposes)
  1.  . I +RMPRETV>0 W !,"SELECTED: " D CODEINFO(RMPRETV) S RMPQUIT=1 Q
  1.  . ;if no data found
  1.  . I +RMPRETV="" W !!,RMPPARAM("NO DATA FOUND") Q
  1.  . ;in ICD10 if the user answered NO for the question "Do you wish to continue(Y/N)?"
  1.  . I +RMPRETV=-4 S RMPQUIT=1 Q
  1.  . ;no changes to the default value 
  1.  . I +RMPRETV=-5 S RMPQUIT=1 Q
  1.  . ;no data or was aborted 
  1.  . I +RMPRETV=-2 S RMPQUIT=1 Q
  1.  . ;if exit due to ^ in the ICD Diagnosis code prompt 
  1.  . I +RMPRETV=-3 S RMPQUIT=1 Q
  1.  . ;if no data found
  1.  . I +RMPRETV=-1,$P(RMPRETV,U,2)=-1 S RMPQUIT=1 Q
  1.  . ;user entered "@" to delete the currently selected ICD code 
  1.  . I +RMPRETV=-6 W !,RMPPARAM("DELETE IT"),! S:$$QUESTION(1,RMPPARAM("TRY ANOTHER"))'=1 RMPQUIT=1 Q
  1.  . ; if continue search
  1.  Q
  1.  ;
  1.  ;//---------
  1.  ;The entry point for ICD-10 diagnosis search functionality
  1.  ;can be called from applications directly
  1.  ;input parameters :
  1.  ; RMPDT - date of interest (Fileman format)
  1.  ; RMPDFLT - default values for the search string (can be a code by default)
  1.  ; RMPPARAM - parameters/string constants (see SETPARAM for details)
  1.  ;returns ICD-10 code selected by the user:
  1.  ; IEN file #80;ICD code value;IEN file # 757.01^description
  1.  ; results
  1.  ; or -1 if invalid data(press enter)
  1.  ; "" if not found 
  1.  ; or -2 if time out
  1.  ; or -3 if ^ or ^^
  1.  ; or -4 in ICD10 if the user answered NO for the question "Do you wish to continue(Y/N)?"
  1.  ; or -5 if no changes to the default value
  1. DIAG10(RMPDT,RMPDFLT,RMPPARAM) ;
  1.  N RMPINP
  1.  F  D  Q:RMPINP<0!($L($P(RMPINP,U,2))>1)
  1.  .S RMPINP=$$SRCHSTR(RMPPARAM("SEARCH_PROMPT"),RMPPARAM("HELP ?"),RMPPARAM("HELP ??"),RMPDFLT)
  1.  .I RMPINP'<0 I $L($P(RMPINP,U,2))'>1 W !!,RMPPARAM("ENTER MORE") W:$L(RMPPARAM("ENTER MORE2"))>0 !,RMPPARAM("ENTER MORE2") W ! ;user should enter at least 2 characters
  1.  I RMPINP<0 Q RMPINP_"^-1"
  1.  Q $$LEXICD10($P(RMPINP,U,2),RMPDT,.RMPPARAM)
  1.  ;
  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.  ; RMPDT - date of interest
  1.  ; RMPDFLT - default values for the search string (can be a code by default)
  1.  ; RMPOUT - local array to return results(passed as a reference)
  1.  ; RMPPARAM - parameters/string constants (see SETPARAM for details)
  1.  ;returns ICD-9 code selected by the user:
  1.  ; IEN file #80;ICD code value^description
  1.  ; -1 no data or was aborted
  1.  ; -2 if timeout 
  1.  ; -3 was aborted
  1.  ; -5 if no changes to the default value
  1. DIAG9(RMPDT,RMPDFLT,RMPOUT,RMPPARAM) ;
  1.  N RMPINP,RMPRETV
  1.  S RMPRETV=$$ICD9(RMPDFLT,RMPDT,.RMPOUT,RMPPARAM("SEARCH_PROMPT"))
  1.  Q RMPRETV
  1.  ;
  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.  ; RMPTXT - search string
  1.  ; RMPDATE - date of interest
  1.  ; RMPPAR - 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
  1.  ; or 
  1.  ; "" if not found 
  1.  ; -1 if exit : ^ or ^^
  1.  ; -2 if continue searching
  1.  ;
  1. LEXICD10(RMPTXT,RMPDATE,RMPPAR) ; ICD-10 Search
  1.  N RMPLVTXT
  1.  ;parameters check
  1.  S RMPDATE=+$G(RMPDATE)
  1.  I RMPDATE'?7N Q -1
  1.  S RMPTXT=$G(RMPTXT)
  1.  Q:'$L(RMPTXT) -1
  1.  N RMPNUMB
  1.  S RMPNUMB=$$FREQ^LEXU(RMPTXT) ; Supported ICR #5679
  1.  I RMPNUMB>$$MAX^LEXU(30) D  I $$QUESTION(2,RMPPAR("WISH CONTINUE"))'=1 Q -4  ; Supported ICR #5679
  1.  . W !
  1.  . D FORMWRIT(RMPPAR("EXCEEDS MESSAGE1")_RMPTXT_RMPPAR("EXCEEDS MESSAGE2")_RMPNUMB_RMPPAR("EXCEEDS MESSAGE3")_RMPTXT_""".",0)
  1.  . D FORMWRIT("",2)
  1.  . W !
  1.  ;new and set variables
  1.  N DIROUT,DUOUT,DTOUT,RMPEXIT,RMPICDNT
  1.  N RMPRETV,RMPXX,RMPLEVEL
  1.  S RMPRETV=""
  1.  S RMPEXIT=0
  1.  S RMPLEVEL=1,RMPLVTXT(RMPLEVEL)=RMPTXT ;level 1 stores the original search string
  1.  ; main loop
  1.  F  Q:RMPEXIT>0  D
  1.  .K RMPICDY
  1.  .;W !,"Level #: ",RMPLEVEL,", search string: ",RMPLVTXT(RMPLEVEL)
  1.  .;get the search string from the current level and call LEX API
  1.  .S RMPICDY=$$DIAGSRCH^LEX10CS(RMPLVTXT(RMPLEVEL),.RMPICDY,RMPDATE,30) ; Supported ICR #5681
  1.  .;W !,"Search for: ",RMPLVTXT(RMPLEVEL),"Date: ",RMPDATE,!! ZW RMPICDY W @IOF
  1.  .S:$O(RMPICDY(" "),-1)>0 RMPICDY=+RMPICDY
  1.  .; Nothing found
  1.  .I +RMPICDY'>0 S RMPEXIT=1 S RMPXX=-1 Q
  1.  .; display the list of items and ask the user to select the item from the list
  1.  .S RMPXX=$$SEL^RMPOICD2(.RMPICDY,8)
  1.  .; if ^ was entered 
  1.  .; if this is on the top level then quit 
  1.  .I RMPXX=-2,RMPLEVEL'>1 S RMPRETV=-1 S RMPEXIT=1 Q
  1.  .; if lower level then go one level up
  1.  .I RMPXX=-2,RMPLEVEL>1 S:RMPLEVEL>1 RMPLEVEL=RMPLEVEL-1 Q
  1.  .; If timeout, or not selected, or ^^ then quit
  1.  .I RMPXX=-1 S RMPRETV=-1 S RMPEXIT=1 Q
  1.  .; if Code Found and Selected by the user save selection in RMPRETV and quit
  1.  .I $P(RMPXX,";")'="99:CAT" S RMPRETV=RMPXX S RMPEXIT=1 Q
  1.  .; If Category Found and Selected by the user: 
  1.  .; go to the next inner level
  1.  .; change level number 
  1.  .S RMPLEVEL=RMPLEVEL+1
  1.  .; set the new level with the new search string
  1.  .; and repeat 
  1.  .S RMPLVTXT(RMPLEVEL)=$P($P($G(RMPXX),"^"),";",2)
  1.  Q RMPRETV
  1.  ;----------
  1.  ;ICD-9 lookup (FileMan lookup)
  1.  ;Supported ICR 5773 (FileMan lookup for files #80 and #80.1)
  1.  ;input parameters :
  1.  ; RMPSRCH - search string/ default values
  1.  ; RMPICDT - date of interest 
  1.  ; RMPOUT - local array to return detailed info (passed as a reference)
  1.  ; RMPPRMT - prompt
  1.  ;returns ICD-9 code selected by the user:
  1.  ; IEN file #80;ICD code value^description
  1.  ; or 
  1.  ; -1 if exit : ^ or ^^
  1.  ; -2 if no results (timeout)
  1.  ;the array RMPOUT returns details if the return value >0, here is an example: 
  1.  ; RMPOUT="6065^814.14"
  1.  ; RMPOUT(0)=814.14
  1.  ; RMPOUT(0,0)=814.14
  1.  ; RMPOUT(0,1)="6065^814.14^^FX PISIFORM-OPEN^^8^^1^^1^^^0^^^^2781001^^1^1"
  1.  ; RMPOUT(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(RMPSRCH,RMPICDT,RMPOUT) ;
  1.  N KEY,X,Y,DIC,RMPCDS
  1.  ;KEY must be newed as ICD lookup code doesn't kill it
  1.  S DIC="^ICD9(",DIC(0)="EQMNZIA"
  1.  S:$G(RMPPRMT)]"" DIC("A")=RMPPRMT
  1.  S:$G(RMPSRCH)]"" DIC("B")=RMPSRCH
  1.  S RMPCDS="ICD9"
  1.  ;note: you must use Y for the 2nd parameter of $$LS^ICDEX & $$CSI^ICDEX
  1.  S DIC("S")="I $$LS^ICDEX(80,+Y,RMPICDT)>0,$$CSI^ICDEX(80,+Y)=1"
  1.  D ^DIC
  1.  M RMPOUT=Y
  1.  I $G(Y) Q $S($D(DTOUT):-2,$D(DUOUT):-1,$D(DUOUT):-1,Y=-1:-1,Y=-5:"",1:+Y_";"_$P(Y,U,2)_U_$G(Y(0,2)))
  1.  Q X
  1.  ;
  1.  ;---------
  1.  ; Clean up environment and quit
  1. EXIT ;
  1.  K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  Q
  1.  ;
  1.  ;-----------
  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.  ; RMPPRMT - prompt
  1.  ;returns YYYMMDD
  1.  ; or -1 if invalid date
  1.  ; or -2 if time out
  1.  ; or -3 if ^
  1. ASKDATE(RMPPRMT) ;
  1.  N %DT,DIROUT,DUOUT,DTOUT
  1.  S %DT="AEX",%DT("A")=$G(RMPPRMT,"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.  ; RMPDFLT- 0/null- not default, 1- yes, 2 -no
  1.  ; RMPPROM - prompt string
  1.  ;returns 
  1.  ; 2 - no,
  1.  ; 1 - yes,
  1.  ; 0 - no answer (time out)
  1.  ; -3 - ^ or ^^
  1. QUESTION(RMPDFLT,RMPPROM,RMPHELP) ;
  1.  N DIR
  1.  S %=$G(RMPDFLT,2)
  1.  S DIR(0)="Y",DIR("A")=RMPPROM,DIR("B")=$S(%=1:"Yes",%=2:"No",1:"")
  1.  S:$L($G(RMPHELP)) DIR("?")=RMPHELP
  1.  D ^DIR
  1.  Q:Y["^" -3
  1.  Q:Y=1 1
  1.  Q:Y=0 2
  1.  Q 0
  1.  ;
  1.  ;------------
  1.  ;get search string
  1.  ;input parameters :
  1.  ; RMPPRMT prompt text
  1.  ; RMPHLP1 "?" help text
  1.  ; RMPHLP2 "??" help text
  1.  ; RMPDFLT- default response
  1.  ;returns piece1 ^ piece 2
  1.  ; piece1:
  1.  ; 0 if normal input
  1.  ; or -1 if invalid data
  1.  ; or -2 if time out
  1.  ; or -3 if ^
  1.  ; or -5 if user accepts default value then no need to validate it
  1.  ; or -6 if user enters "@"
  1.  ; piece2: string entered by the user
  1. SRCHSTR(RMPPRMT,RMPHLP1,RMPHLP2,RMPDFLT) ;
  1.  N DIR
  1.  S DIR("A")=RMPPRMT
  1.  S:($G(RMPHLP1)]"") DIR("?")=RMPHLP1
  1.  S:($G(RMPHLP2)]"") DIR("??")=RMPHLP2
  1.  I $L($G(RMPDFLT)) S DIR("B")=RMPDFLT
  1.  S DIR(0)="FAOr^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:(($L($G(RMPDFLT)))&(Y=RMPDFLT)) -5 ;if user accepts default value then no need to validate it
  1.  Q 0_U_Y
  1.  ;
  1.  ;----------
  1.  ;Determines and returns ACTIVE coding system for DIAGNOSES based on date of interest 
  1.  ;input parameters :
  1.  ; RMPICDD - 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.  ; 1 if ICD-9-CM is active system
  1. ICDSYSDG(RMPICDD) ; 
  1.  N RMPIMPDT
  1.  S RMPICDD=$S(RMPICDD<0!($L(+RMPICDD)'=7):DT,1:+$G(RMPICDD))
  1.  S RMPIMPDT=$$IMPDATE^LEXU("10D")
  1.  Q $S(RMPICDD'<RMPIMPDT: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 application's needs
  1.  ;input parameters 
  1.  ; RMPPAR - local array to set and store string constants for your messages and prompts 
  1. SETPARAM(RMPPAR) ;
  1.  S RMPPAR("SEARCH_PROMPT")="ICD-10 DIAGNOSIS CODE: "
  1.  S RMPPAR("HELP ?")="^D INPHLP^RMPOICD1"
  1.  S RMPPAR("HELP ??")="^D INPHLP2^RMPOICD1"
  1.  S RMPPAR("NO DATA FOUND")=" No data found"
  1.  S RMPPAR("EXITING")=" Exiting"
  1.  S RMPPAR("TRY LATER")=" Try again later"
  1.  S RMPPAR("NO DATA SELECTED")=" No data selected"
  1.  S RMPPAR("TRY ANOTHER")="Try another"
  1.  S RMPPAR("WISH CONTINUE")="Do you wish to continue(Y/N)"
  1.  S RMPPAR("EXCEEDS MESSAGE1")="Searching for """
  1.  S RMPPAR("EXCEEDS MESSAGE2")=""" requires inspecting "
  1.  S RMPPAR("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 RMPPAR("NO CHANGES")=" No changes made"
  1.  S RMPPAR("DELETE IT")="   SURE YOU WANT TO DELETE"
  1.  S RMPPAR("ENTER MORE")=" Please enter at least the first two characters of the ICD-10 code or code"
  1.  S RMPPAR("ENTER MORE2")=" description to start the search."
  1.  S RMPPAR("YES OR NO")="Answer 'Y' for 'Yes' or 'N' for 'No'"
  1.  Q
  1.  ;
  1.  ;
  1.  ;a wrapper for ^DIWP
  1.  ;accumulates a text and then writes it to the device
  1.  ;input parameters :
  1.  ; X - text
  1.  ; RMPMODE:
  1.  ; 0 - start
  1.  ; 1 - accumulate 
  1.  ; 2 - write
  1.  ;example:
  1.  ;D FORMWRIT^ZZLXDG("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^ZZLXDG("some more text ",1)
  1.  ;D FORMWRIT^ZZLXDG("",2)
  1. FORMWRIT(X,RMPMODE) ;
  1.  N RMPLI1
  1.  ;if "start" mode
  1.  I RMPMODE=0 K ^UTILITY($J,"W")
  1.  S DIWL=1,DIWR=79
  1.  I $L(X)>0 D ^DIWP
  1.  ;if "write" mode
  1.  I RMPMODE=2 D
  1.  . S RMPLI1=0 F  S RMPLI1=$O(^UTILITY($J,"W",1,RMPLI1)) Q:+RMPLI1=0  W !,$G(^UTILITY($J,"W",1,RMPLI1,0))
  1.  . K ^UTILITY($J,"W")
  1.  Q
  1.  ;
  1.  ;---------------
  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.",RMPKEY:DTIME
  1.  Q
  1.  ;display code info (used for demo)
  1. CODEINFO(RMPXX2) ; Write Output
  1.  N RMPKEY
  1.  W !," ICD Diagnosis code:",?30,$P(RMPXX2,";",2)
  1.  W !," ICD Diagnosis code IEN:",?30,$P(RMPXX2,";",1)
  1.  W !," Lexicon Expression IEN:",?30,+$P(RMPXX2,";",3)
  1.  W !," ICD Diagnosis description:",?30,$P(RMPXX2,"^",2)
  1.  Q
  1.  ;