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

YSLXDG.m

Go to the documentation of this file. 
  1. YSLXDG ; ALB/RBD - ICD-10 DIAGNOSIS CODE LOOK UP FOR MENTAL HEALTH ;10 May 2013  11:17 AM
  1.  ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
  1.  ;
  1.  ;based on ^ZZLXDG which is the standard Diagnosis Search Protocol
  1.  ;beginning routine.
  1.  ;
  1.  Q
  1.  ;
  1. EN ;
  1.  D INITVARS ;set standards variables, you might not need this if it
  1.  ; was already done in your application
  1.  N YSQUIT ; to manage loop
  1.  K YSRETV ;to store the selected code information
  1.  N YSPARAM ;  to set your application specific prompts and messages
  1.  N YSCSYS ;coding system "ICD9" or ICD10"
  1.  N YSOUT ;to return all available information about the selected code
  1.  ;settings:
  1.  D SETPARAM(.YSPARAM) ;edit the SETPARAM subroutine below to set your
  1.  ; application specific prompts
  1.  I YSDT'>0 S YSRETV=-1 Q
  1.  ;starting main loop
  1.  S YSQUIT=0 F  Q:YSQUIT=1  D
  1.  . S YSRETV=0,YSOUT=""
  1.  . W !!   ;reprompt a few lines down
  1.  . ;prompt for the date of interest (date should be available for MH)
  1.  . I YSDT'>0 S YSRETV=-1,YSQUIT=1 Q
  1.  . ;S YSDT=$$ASKDATE(YSPARAM("ASKDATE"))
  1.  . ;prompt for "try again" with "No" as default if ^ or null entered
  1.  . ;for the date or if timed out
  1.  . I YSDT'>0 S:$$QUESTION(2,YSPARAM("TRY ANOTHER"))'=1 YSQUIT=1 Q
  1.  . ;determine coding system based on the date of interest
  1.  . ;If coding system not ICD-10 or greater, then Quit (let MH code
  1.  . ; handle it as before for now)
  1.  . S YSCSYS=$$ICDSYSDG(YSDT) I YSCSYS=1 S YSRETV=-1,YSQUIT=1 Q
  1.  . ;set default response for your prompt
  1.  . S YSDFLT=""
  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
  1.  . ;new file #80.4)
  1.  . I YSCSYS=1 S YSRETV=$$DIAG9(YSDT,YSDFLT,.YSOUT,.YSPARAM) I YSRETV=-2 S:$$QUESTION(1,YSPARAM("TRY ANOTHER"))'=1 YSQUIT=1 Q
  1.  . ;ICD10 (30 is a pointer to the ICD-10 diagnosis system entry in the new file #80.4)
  1.  . I YSCSYS=30 S YSRETV=$$DIAG10(YSDT,YSDFLT,.YSPARAM)
  1.  . I $P(YSRETV,U,2)="LIST CHOICE" S YSRETV=$P(YSRETV,U,1),YSQUIT=1 Q
  1.  . ;display information about the code selected
  1.  . I YSRETV>0 W !,"SELECTED: " D CODEINFO(YSRETV) S YSQUIT=1 Q
  1.  . ;if no data found
  1.  . I YSRETV="" W !!,YSPARAM("NO DATA FOUND") S:$$QUESTION(1,YSPARAM("TRY ANOTHER"))'=1 YSQUIT=1,YSRETV=-1 Q
  1.  . ;in ICD10 if the user answered NO for the question "Do you wish to continue(Y/N)?"
  1.  . I YSRETV=-4 S:$$QUESTION(1,YSPARAM("TRY ANOTHER"))'=1 YSQUIT=1 Q
  1.  . ;no data or was aborted
  1.  . I YSRETV=-2 S:$$QUESTION(1,YSPARAM("TRY ANOTHER"))'=1 YSQUIT=1 Q
  1.  . ;if exit due to ^ in the ICD Diagnosis code prompt
  1.  . I YSRETV=-3 S:$$QUESTION(2,YSPARAM("TRY ANOTHER"))'=1 YSQUIT=1 Q
  1.  . ;if no data found
  1.  . I YSRETV=-1 S:$$QUESTION(2,YSPARAM("TRY ANOTHER"))'=1 YSQUIT=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.  ; YSDT - date of interest
  1.  ; YSDFLT - default values for the search string (can be a code by default)
  1.  ; YSOUT - local array to return results (passed as a reference)
  1.  ; YSPARAM - 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)
  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.  ; 
  1. DIAG10(YSDT,YSDFLT,YSPARAM) ;
  1.  N YSINP
  1.  S YSINP=$$SRCHSTR(YSPARAM("SEARCH_PROMPT"),YSPARAM("HELP ?"),YSPARAM("HELP ??"),YSDFLT)
  1.  I YSINP<0 Q +YSINP
  1.  I $P(YSINP,U,2)?.N Q $P(YSINP,U,2)_U_"LIST CHOICE"
  1.  Q $$LEXICD10($P(YSINP,U,2),YSDT,.YSPARAM)
  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.  ; YSDT - date of interest
  1.  ; YSDFLT - default values for the search string (can be a code by default)
  1.  ; YSOUT - local array to return results(passed as a reference)
  1.  ; YSPARAM - 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.  ;  -2 no data or was aborted
  1.  ;  -1 if timeout
  1. DIAG9(YSDT,YSDFLT,YSOUT,YSPARAM) ;
  1.  N YSINP,YSRETV
  1.  S YSINP=$$SRCHSTR(YSPARAM("SEARCH_PROMPT"),YSPARAM("HELP ?"),YSPARAM("HELP ??"),YSDFLT)
  1.  I YSINP=-1 Q -1  ;enter
  1.  I YSINP=-3 Q -1  ;^ or ^^
  1.  I YSINP=-2 Q -2  ;timeout or not found
  1.  I YSINP=-1!(YSINP=-3) Q -2
  1.  I YSINP<0 Q +YSINP
  1.  S YSRETV=$$ICD9($P(YSINP,U,2),YSDT,.YSOUT)
  1.  I YSRETV=-1 Q -2
  1.  Q YSRETV
  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.  ; YSTXT - search string
  1.  ; YSDATE - date of interest
  1.  ; YSPAR - 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(YSTXT,YSDATE,YSPAR) ; ICD-10 Search
  1.  N YSLVTXT
  1.  ;parameters check
  1.  S YSDATE=+$G(YSDATE)
  1.  S YSDATE=$P(YSDATE,".",1)
  1.  I YSDATE'?7N Q -1
  1.  S YSTXT=$G(YSTXT)
  1.  Q:'$L(YSTXT) -1
  1.  N YSNUMB
  1.  S YSNUMB=$$FREQ^LEXU(YSTXT)
  1.  I YSNUMB>$$MAX^LEXU(30) D  I $$QUESTION("N",YSPARAM("WISH CONTINUE"))'=1 Q -4
  1.  . W ! D FORMWRIT(YSPAR("EXCEEDS MESSAGE1")_YSTXT_YSPAR("EXCEEDS MESSAGE2")_YSNUMB_YSPAR("EXCEEDS MESSAGE3")_YSTXT_""".",0)
  1.  . D FORMWRIT("",2) W !
  1.  ;new and set variables
  1.  N DIROUT,DUOUT,DTOUT,YSEXIT,YSICDNT
  1.  N YSRETV,YSXX,YSLEVEL
  1.  S YSRETV=""
  1.  S YSEXIT=0
  1.  S YSLEVEL=1,YSLVTXT(YSLEVEL)=YSTXT ;level 1 stores the original search string
  1.  ; main loop
  1.  F  Q:YSEXIT>0  D
  1.  .K YSICDY
  1.  .;W !,"Level #: ",YSLEVEL,", search string: ",YSLVTXT(YSLEVEL)
  1.  .;get the search string from the current level and call LEX API
  1.  .S YSICDY=$$DIAGSRCH^LEX10CS(YSLVTXT(YSLEVEL),.YSICDY,YSDATE,30)
  1.  .S:$O(YSICDY(" "),-1)>0 YSICDY=+YSICDY
  1.  .; Nothing found
  1.  .I +YSICDY'>0 S YSEXIT=1 S YSXX=-1 Q
  1.  .; display the list of items and ask the user to select the item from the list
  1.  .S YSXX=$$SEL^YSLXDG2(.YSICDY,8)
  1.  .; if ^ was entered
  1.  .;   if this is on the top level then quit
  1.  .I YSXX=-2,YSLEVEL'>1 S YSRETV=-1 S YSEXIT=1 Q
  1.  .;   if lower level then go one level up
  1.  .I YSXX=-2,YSLEVEL>1 S:YSLEVEL>1 YSLEVEL=YSLEVEL-1 Q
  1.  .; If timeout, or not selected, or ^^ then quit
  1.  .I YSXX=-1 S YSRETV=-1 S YSEXIT=1 Q
  1.  .; if Code Found and Selected by the user save selection in YSRETV and quit
  1.  .I $P(YSXX,";")'="99:CAT" S YSRETV=YSXX S YSEXIT=1 Q
  1.  .; If Category Found and Selected by the user:
  1.  .;  go to the next inner level
  1.  .;  change level number
  1.  .S YSLEVEL=YSLEVEL+1
  1.  .;  set the new level with the new search string
  1.  .;  and repeat
  1.  .S YSLVTXT(YSLEVEL)=$P($P($G(YSXX),"^"),";",2)
  1.  Q YSRETV
  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.  ; YSSRCH - search string
  1.  ; YSICDT - date of interest
  1.  ; YSOUT - 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
  1.  ; "" if not found
  1.  ; -1 if exit : ^ or ^^
  1.  ; -2 if continue search
  1.  ;the array YSOUT returns details if the return value >0, here is an example:
  1.  ; YSOUT="6065^814.14"
  1.  ; YSOUT(0)=814.14
  1.  ; YSOUT(0,0)=814.14
  1.  ; YSOUT(0,1)="6065^814.14^^FX PISIFORM-OPEN^^8^^1^^1^^^0^^^^2781001^^1^1"
  1.  ; YSOUT(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(YSSRCH,YSICDT,YSOUT) ;
  1.  N KEY,X,Y,DIC,YSCDS
  1.  ;KEY must be newed as ICD lookup code doesn't kill it
  1.  S DIC="^ICD9(",DIC(0)="EQXZ"
  1.  S YSCDS="ICD9"
  1.  ;note: you must use Y for the 2nd parameter of $$ICDDATA^ICDXCODE
  1.  S DIC("S")="I $P($$ICDDATA^ICDXCODE(YSCDS,Y,YSICDT),U,10)=1"
  1.  ; both X and Y should be set to the search string
  1.  S (X,Y)=YSSRCH
  1.  D ^DIC
  1.  M YSOUT=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.  ;---------
  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 ICD10s.
  1. INPHLP ; Help text controller for ICD-10
  1.  I X["???" D QM3 Q
  1.  I X["??" D QM2 Q
  1.  I X["?" D QM1 Q
  1.  Q
  1. QM ; Diagnosis help text
  1. QM1 ; simple help text for 1 question mark
  1.  W !,"Enter code or ""text"" for more information.",!
  1.  Q
  1. QM2 ; enhanced help text for 2 question marks
  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 associated"
  1.  W !,"with the code.",!
  1.  W !," or",!
  1.  W !,"Enter a ""partial code"". Include the decimal when a search criterion includes"
  1.  W !,"3 characters or more for code searches.",!
  1.  Q
  1. QM3 ; further explanation of format when there are multiple returns, displayed for 3 question marks.
  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 and"
  1.  W !,"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"
  1.  W !,"         ""family"" that are possible selections.",!
  1.  Q
  1.  ;
  1. MIN2 ; Minimum length of 2 characters message
  1.  W $C(7),"  ??",!
  1.  W !,"Please enter at least the first two characters of the ICD-10 code or "
  1.  W !,"code description to start the search.",!
  1.  Q
  1.  ;
  1. INPHLP2 ; Look-up help for ICD9s
  1.  W !," Enter a ""free text"" term. Best results occur using one to "
  1.  W !," three full or partial words without a suffix"
  1.  W:$G(X)'["??" "."
  1.  W:$G(X)["??" " (i.e., ""DIABETES"","
  1.  W:$G(X)["??" !," ""DIAB MELL"",""DIAB MELL INSUL"")"
  1.  W !," or "
  1.  W !," Enter a classification code (ICD/CPT etc) to find the single "
  1.  W !," term associated with the code."
  1.  W:$G(X)["??" " Example, a lookup of code 239.0 "
  1.  W:$G(X)["??" !," returns one and only one term, that is the preferred "
  1.  W:$G(X)["??" !," term for the code 239.0, ""Neoplasm of unspecified nature "
  1.  W:$G(X)["??" !," of digestive system"""
  1.  W !," or "
  1.  W !," Enter a classification code (ICD/CPT etc) followed by a plus"
  1.  W !," sign (+) to retrieve all terms associated with the code."
  1.  W:$G(X)["??" " Example,"
  1.  W:$G(X)["??" !," a lookup of 239.0+ returns all terms that are linked to the "
  1.  W:$G(X)["??" !," code 239.0."
  1.  Q
  1.  ;--------
  1.  ;prompt the user for a date of interest
  1.  ;input parameters :
  1.  ; YSPRMT - prompt
  1.  ;returns YYYMMDD
  1.  ; or -1 if invalid date
  1.  ; or -2 if time out
  1.  ; or -3 if ^
  1. ASKDATE(YSPRMT) ;
  1.  N %DT,DIROUT,DUOUT,DTOUT
  1.  S %DT="AEX",%DT("A")=$G(YSPRMT,"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.  ; YSDFLT- 0/null- not default, 1- yes, 2 -no
  1.  ; YSPROM - prompt string
  1.  ;returns
  1.  ; 2 - no,
  1.  ; 1 -yes,
  1.  ; 0 - no answer
  1. QUESTION(YSDFLT,YSPROM) ;
  1.  W:$L($G(YSPROM)) !,YSPROM
  1.  S %=$G(YSDFLT,2)
  1.  D YN^DICN
  1.  Q:%Y["^" -3
  1.  I %=2!(%=1) Q %
  1.  Q -2
  1.  ;
  1.  ;------------
  1.  ;get search string
  1.  ;input parameters :
  1.  ; YSPRMT prompt text
  1.  ; YSHLP1 "?" help text
  1.  ; YSHLP2 "??" help text
  1.  ; YSDFLT- 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.  ; piece2: string entered by the user
  1. SRCHSTR(YSPRMT,YSHLP1,YSHLP2,YSDFLT) ;
  1. SRCHST2 N DIR
  1.  S DIR("A")=YSPRMT
  1.  S DIR("?")=YSHLP1
  1.  S DIR("??")=YSHLP2
  1.  I $L($G(YSDFLT)) S DIR("B")=YSDFLT
  1.  S DIR(0)="FAO^0:245"
  1.  D ^DIR
  1.  Q:$D(DTOUT) -2
  1.  Q:$D(DUOUT) -3
  1.  Q:Y["^" -3
  1.  I $L(Y)=1 D MIN2 G SRCHST2
  1.  Q:Y="" -1
  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.  ; YSICDD - 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 (suppported ICR 5780)
  1.  ; 30  if ICD-10-CM is active system
  1.  ; 1   if ICD-9-CM is active system
  1. ICDSYSDG(YSICDD) ;
  1.  N YSIMPDT
  1.  S YSICDD=$S(YSICDD<0!($L($P(YSICDD,".",1))'=7):DT,1:+$G(YSICDD))
  1.  S YSIMPDT=$$IMPDATE^LEXU("10D")
  1.  Q $S(YSICDD'<YSIMPDT:30,1:1)
  1.  ;
  1.  ;set parameters
  1.  ;edit these hardcoded strings that areused for prompts, messages and so on to adjust
  1.  ;them to your applicaion's needs
  1.  ;input parameters
  1.  ; YSPAR - local array to sets and store string constants for your messages and prompts 
  1. SETPARAM(YSPAR) ;
  1.  S YSPAR("ASKDATE")="Date of interest? "
  1.  S YSPAR("SEARCH_PROMPT")="Enter ICD-10 DIAGNOSIS: "   ; assume ICD-10
  1.  S YSPAR("HELP ?")="^D INPHLP^YSLXDG"
  1.  S YSPAR("HELP ??")="^D INPHLP^YSLXDG"
  1.  S YSPAR("NO DATA FOUND")="  No data found"
  1.  S YSPAR("EXITING")="  Exiting"
  1.  S YSPAR("TRY LATER")="  Try again later"
  1.  S YSPAR("NO DATA SELECTED")="  No data selected"
  1.  S YSPAR("TRY ANOTHER")="Try another"
  1.  S YSPAR("WISH CONTINUE")="Do you wish to continue (Y/N)"
  1.  S YSPAR("EXCEEDS MESSAGE1")="Searching for """
  1.  S YSPAR("EXCEEDS MESSAGE2")=""" requires inspecting "
  1.  S YSPAR("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.  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.  ; YSMODE:
  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,YSMODE) ;
  1.  N YSLI1
  1.  ;if "start" mode
  1.  I YSMODE=0 K ^UTILITY($J,"W")
  1.  S DIWL=1,DIWR=79
  1.  I $L(X)>0 D ^DIWP
  1.  ;if "write" mode
  1.  I YSMODE=2 D
  1.  . S YSLI1=0 F  S YSLI1=$O(^UTILITY($J,"W",1,YSLI1)) Q:+YSLI1=0  W !,$G(^UTILITY($J,"W",1,YSLI1,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
  1. PRESSKEY ;
  1.  R !!,"Press any key to continue.",YSKEY:DTIME
  1.  Q
  1.  ;display code info
  1. CODEINFO(YSXX2) ; Write Output
  1.  N YSKEY,YSICDSTR
  1.  S YSICDSTR="ICD"_$S(YSCSYS="30":"10",1:"9")
  1.  N YSTXT,YSI S YSTXT(1)=$P($P(YSXX2,";",2),U,2)
  1.  D PR^YSLXDG2(.YSTXT,48)
  1.  W !," ",YSICDSTR," Diagnosis code:",?31,$P($P(YSXX2,";",2),U,1)
  1.  W !," ",YSICDSTR," Diagnosis description:",?31,YSTXT(1)
  1.  S YSI=1 F  S YSI=$O(YSTXT(YSI)) Q:+YSI'>0  W !,?31,$G(YSTXT(YSI))
  1.  Q
  1.  ;