HBHCLKU1 ;ALB/KG - DIAGNOSIS VALIDATION AND LOOK UP ;5/15/12
;;1.0;HOSPITAL BASED HOME CARE;**25**;NOV 01, 1993;Build 45
;
; This routine references the following supported ICRs:
; 5747 $$CODEC^ICDEX
; 5747 $$VSTD^ICDEX
; 5747 $$CSI^ICDEX
; 5747 $$SYS^ICDEX
; 5747 $$SAI^ICDEX
; 5681 $$DIAGSRCH^LEX10CS
; 5679 $$FREQ^LEXU
; 5679 $$MAX^LEXU
; 5773 FileMan lookup for file #80
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;HBH*1.0*25 APR 2012 K GUPTA Support for ICD-10 Coding System
;******************************************************************************
;******************************************************************************
;
;---------
;Diagnosis validation based on Evaluation/Admission date
;Called by:
; - PROMPT^HBHCADM
ADMDXVLD ;
D DXVLD(1,HBHCDFN)
Q
;
;---------
;Diagnosis validation based on Discharge date
;Called by:
; - HBHC DISCHARGE Input Template
; - HBHC UPDATE DISCHARGE Input Template
;Input parameters:
; HBHCDFN1 - ^HBHC(631 IEN
DCDXVLD(HBHCDFN1) ;
D DXVLD(2,HBHCDFN1)
Q
;
;---------
;Diagnosis validation based on date entry
;Input parameters:
; HBHCMODE - Admission or Discharge
; HBHCDFN1 - ^HBHC(631 IEN
DXVLD(HBHCMODE,HBHCDFN1) ;
N HBHCDT,HBHCCURDXIEN
;date of interest
I HBHCMODE=1 S HBHCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,18) I 1 ;admission date
E I HBHCMODE=2 S HBHCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,40) ;discharge date
S HBHCCURDXIEN=$$GETDX(HBHCMODE,HBHCDFN1)
;check if dx's coding system is still valid based on date of interest
;if not valid then clear out old value
I HBHCCURDXIEN>0,'$$CHECKDX(HBHCCURDXIEN,HBHCDT) D SAVEDX(HBHCMODE,HBHCDFN1,"","")
Q
;
;Diagnosis defaulting for Discharge
;Called by:
; - HBHC DISCHARGE Input Template
; - HBHC UPDATE DISCHARGE Input Template
;Input parameters:
; HBHCDFN1 - File #631 - patient identifier
;Output value:
; Admission dx if coding system matches with coding system of discharge date
;
DFLTDCDX(HBHCDFN1) ;
N HBHCDCDX,HBHCADMDX,HBHCDCDT
S HBHCDCDX=$P($G(^HBHC(631,HBHCDFN1,0)),U,47) ; PRIMARY DIAGNOSIS @ DISCHARGE
I HBHCDCDX="" D
. S HBHCADMDX=$P($G(^HBHC(631,HBHCDFN1,0)),U,19) ;admission dx
. Q:HBHCADMDX=""
. S HBHCDCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,40) ;discharge date
. ;default adm dx only if dx coding system matches with discharge date's coding system
. S:$$CHECKDX(HBHCADMDX,HBHCDCDT) HBHCDCDX=HBHCADMDX
Q HBHCDCDX
;
;Diagnosis validation based on date of interest
;Input parameters:
; HBHCDX - Diagnosis IEN
; HBHCDT - Date of interest
;Output value:
; "1" - if coding system matches
; "" - error or if coding system don't match
;
CHECKDX(HBHCDX,HBHCDT) ;
N HBHCDXCS,HBHCDTCS
Q:(HBHCDX="")!(HBHCDT="") ""
S HBHCDXCS=$$CSI^ICDEX("80",HBHCDX) ;determine coding system for dx
Q:HBHCDXCS="" ""
S HBHCDTCS=$$SYS^ICDEX("80",HBHCDT,"I") ;determine coding system for date
Q:HBHCDTCS=-1 ""
Q:HBHCDXCS=HBHCDTCS "1" ;if two coding system matches
Q ""
;
;---------
;Diagnosis entry for Evaluation/Admission
;Called by:
; - PROMPT^HBHCADM
ADMDX ;
D ICD(1,HBHCDFN)
Q
;
;---------
;Diagnosis entry for Discharge
;Called by:
; - HBHC DISCHARGE Input Template
; - HBHC UPDATE DISCHARGE Input Template
;Input parameters:
; HBHCDFN1 - ^HBHC(631 IEN
DCDX(HBHCDFN1) ;
D ICD(2,HBHCDFN1)
Q
;
;---------
;Diagnosis entry
;Input parameters
; HBHCMODE - Admission or Discharge
; HBHCDFN1 - ^HBHC(631 IEN
ICD(HBHCMODE,HBHCDFN1) ;
D INITVARS ;set standards variables, you might not need this if it was already done in your application
N HBHCRETV,HBHCPARAM,HBHCDT,HBHCSYS,HBHCDFLT,HBHCCURDXIEN,HBHCQUIT,HBHCNEWDXIEN
;date of interest
I HBHCMODE=1 S HBHCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,18) I 1 ;admission date
E I HBHCMODE=2 S HBHCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,40) ;discharge date
S HBHCSYS=$$SYS^ICDEX("80",HBHCDT,"I") ;determine coding system based on the date of interest
;settings
D SETPARAM(.HBHCPARAM,HBHCMODE,HBHCSYS)
;default response for the prompt
S HBHCDFLT=""
S HBHCCURDXIEN=+$$GETDX(HBHCMODE,HBHCDFN1)
S:HBHCCURDXIEN>0 HBHCDFLT=$$CODEC^ICDEX(80,HBHCCURDXIEN)_" "_$$VSTD^ICDEX(HBHCCURDXIEN,HBHCDT)
S HBHCQUIT=0 F Q:HBHCQUIT=1 D
. S HBHCRETV=0
. ;run either ICD9 or ICD10 prompt/search/select logic
. ;ICD9 (1 is a pointer to the ICD-9 diagnosis system entry in the new file #80.4 )
. I HBHCSYS=1 S HBHCRETV=$$DIAG9(HBHCDT,HBHCDFLT,.HBHCPARAM) I 1
. ;ICD10 (30 is a pointer to the ICD-10 diagnosis system entry in the new file #80.4 )
. E I HBHCSYS=30 S HBHCRETV=$$DIAG10(HBHCDT,HBHCDFLT,.HBHCPARAM)
. D CLEANUP
. S HBHCNEWDXIEN=$P(HBHCRETV,";",1)
. I HBHCNEWDXIEN>0 D SAVEDX(HBHCMODE,HBHCDFN1,HBHCNEWDXIEN,HBHCDT) S HBHCQUIT=1 Q ;if a new dx is selected
. I HBHCNEWDXIEN=-1 S HBHCQUIT=1 Q ;Dx entry prompt: user pressed "enter" with no default, so quit dx entry and go to next prompt
. I HBHCNEWDXIEN=-2 S Y=0,HBHCQUIT=1 Q ;Dx entry prompt: timed out, so quit dx entry and quit entire admission entry
. I HBHCNEWDXIEN=-3 S Y=0,HBHCQUIT=1 Q ;Dx entry prompt: user entered "^", so quit entry and quit entire admission entry
. I HBHCNEWDXIEN=-4 S HBHCQUIT=1 Q ;Dx entry prompt: user pressed "enter" with default value
. I HBHCNEWDXIEN=-5 D Q ;Dx entry prompt: user entered "@", so ask Y/N question to user
. . I HBHCCURDXIEN'>0 S HBHCQUIT=0 Q
. . I $$QUESTION("",HBHCPARAM("DELETE?"))=1 D I 1
. . . D SAVEDX(HBHCMODE,HBHCDFN1,"",HBHCDT)
. . . S HBHCQUIT=1
. . E S HBHCQUIT=0
. I HBHCNEWDXIEN=-6 S Y=0,HBHCQUIT=1 Q ;Dx search prompt: timed out, so quit dx entry and quit entire admission entry
. I HBHCNEWDXIEN=-7 S HBHCQUIT=0 Q ;Dx search prompt: user entered "^" or "^^", so quit search, ask dx entry again
. I HBHCNEWDXIEN=-8 S HBHCQUIT=0 Q ;Dx search prompt: user selected nothing, so ask dx entry again
. I HBHCNEWDXIEN=-9 S HBHCQUIT=0 Q ;Dx search prompt: in ICD10 if the user answered NO when warned about lot of result found
. I HBHCNEWDXIEN="" W " No data found",! S HBHCQUIT=0 Q ;Dx search prompt: no data found when user searched, so ask dx entry again
Q
;
;---------
;Save Admission or Discharge diagnosis
;Input parameters
; HBHCMODE - Admission or Discharge
; HBHCDFN1 - ^HBHC(631 IEN
; HBHCDXIEN - Diagnosis IEN
; HBHCDT - Date of interest
SAVEDX(HBHCMODE,HBHCDFN1,HBHCDXIEN,HBHCDT) ;
N HBHCPC
I HBHCMODE=1 S HBHCPC=19 I 1
E I HBHCMODE=2 S HBHCPC=47
S $P(^HBHC(631,HBHCDFN1,0),U,HBHCPC)=HBHCDXIEN
W:HBHCDXIEN>0 " "_$$CODEC^ICDEX(80,HBHCDXIEN)_" "_$$VSTD^ICDEX(HBHCDXIEN,HBHCDT)
Q
;
;---------
;Get Admission or Discharge diagnosis
;Input parameters
; HBHCMODE - Admission or Discharge
; HBHCDFN1 - ^HBHC(631 IEN
GETDX(HBHCMODE,HBHCDFN1) ;
N HBHCPC
I HBHCMODE=1 S HBHCPC=19 I 1
E I HBHCMODE=2 S HBHCPC=47
Q $P($G(^HBHC(631,HBHCDFN1,0)),U,HBHCPC)
;
;---------
;The entry point for ICD-10 diagnosis search functionality
;can be called from applications directly
;input parameters :
; HBHCDT - date of interest (Fileman format)
; HBHCDFLT - default values for the search string (can be a code by default)
; HBHCPARAM - parameters/string constants (see SETPARAM for details)
;returns ICD-10 code selected by the user:
; IEN file #80;ICD code value;IEN file #757.01^description
; results
; or -1 Dx entry prompt: if invalid data(press enter)
; or -2 Dx entry prompt: if time out
; or -3 Dx entry prompt: if ^ or ^^
; or -4 Dx entry prompt: if no changes to the default value
; or -5 Dx entry prompt: if user enters "@"
; or -6 Dx search prompt: if timed out
; or -7 Dx search prompt: search was aborted by user by entering "^" or "^^"
; or -8 Dx search prompt: user selected nothing
; or -9 Dx search prompt: if the user answered NO for the question "Do you wish to continue(Y/N)?"
; or "" Dx search prompt: if not found
;
DIAG10(HBHCDT,HBHCDFLT,HBHCPARAM) ;
N HBHCINP,HBHCRETV
F D Q:HBHCINP<0!($L($P(HBHCINP,U,2))>1)
. S HBHCINP=$$SRCHSTR(HBHCPARAM("SEARCH_PROMPT"),HBHCPARAM("HELP ?"),HBHCPARAM("HELP ??"),HBHCDFLT)
. I HBHCINP'<0 I $L($P(HBHCINP,U,2))'>1 W !!,HBHCPARAM("ENTER MORE") W:$L(HBHCPARAM("ENTER MORE2"))>0 !,HBHCPARAM("ENTER MORE2") W ! ;user should enter at least 2 characters
I HBHCINP<0 Q +HBHCINP
S HBHCRETV=$$LEXICD10($P(HBHCINP,U,2),HBHCDT,.HBHCPARAM)
I HBHCRETV=-1 Q -8 ;non selection
I HBHCRETV=-2 Q -6 ;search timed out
I HBHCRETV=-3 Q -7 ;search was aborted by user by entering "^" or "^^"
I HBHCRETV=-4 Q -9 ;user answered NO for the question "Do you wish to continue(Y/N)?" when search returned lot of values
Q HBHCRETV
;
;---------
;The entry point for ICD-9 FileMan type (^DIC) diagnosis search functionality
;can be called from applications directly
;input parameters :
; HBHCDT - date of interest
; HBHCDFLT - default values for the search string (can be a code by default)
; HBHCPARAM - parameters/string constants (see SETPARAM for details)
;returns ICD-9 code selected by the user:
; IEN file #80;ICD code value^description
; or -1 Dx entry prompt: if invalid data(press enter)
; or -2 Dx entry prompt: if time out
; or -3 Dx entry prompt: if ^ or ^^
; or -4 Dx entry prompt: if no changes to the default value
; or -5 Dx entry prompt: if user enters "@"
; or -6 Dx search prompt: if time out
; or -7 Dx search prompt: search was aborted by user by entering "^" or "^^"
; or -8 Dx search prompt: user selected nothing
; or "" Dx search prompt: if not found
;
DIAG9(HBHCDT,HBHCDFLT,HBHCPARAM) ;
N HBHCINP,HBHCRETV
S HBHCINP=$$SRCHSTR(HBHCPARAM("SEARCH_PROMPT"),HBHCPARAM("HELP ?"),HBHCPARAM("HELP ??"),HBHCDFLT)
I +HBHCINP<0 Q +HBHCINP
S HBHCRETV=$$FMICD9($P(HBHCINP,U,2),HBHCDT)
S HBHCRETV=$P(HBHCRETV,U,1)
I HBHCRETV=-3 Q -6 ;search timed-out
I HBHCRETV=-2 Q -7 ;search was aborted by user by entering "^" or "^^"
I HBHCRETV=-1 Q -8 ;user selected nothing or no values found
Q HBHCRETV
;
;---------
;The entry point for ICD-10 diagnosis search functionality
;input parameters :
; HBHCTXT - search string
; HBHCDATE - date of interest
; HBHCPAR - array with text messages and other string constants
;returns ICD-10 code selected by the user:
; IEN file #80;ICD code value^description
; or
; "" if not found
; -1 if non selection
; -2 if search timed out
; -3 if search was aborted by user by entering "^" or "^^"
; -4 if user answered NO for the question "Do you wish to continue(Y/N)?" when search returned lot of values
;
LEXICD10(HBHCTXT,HBHCDATE,HBHCPAR) ; ICD-10 Search
N HBHCLVTXT
;parameters check
S HBHCDATE=+$G(HBHCDATE)
I HBHCDATE'?7N Q -1
S HBHCTXT=$G(HBHCTXT)
Q:'$L(HBHCTXT) -1
N HBHCNUMB
S HBHCNUMB=$$FREQ^LEXU(HBHCTXT)
I HBHCNUMB>$$MAX^LEXU(30) D I $$QUESTION("N",HBHCPARAM("WISH CONTINUE"))'=1 Q -4
. D FORMWRIT(HBHCPAR("EXCEEDS MESSAGE1")_HBHCTXT_HBHCPAR("EXCEEDS MESSAGE2")_HBHCNUMB_HBHCPAR("EXCEEDS MESSAGE3")_HBHCTXT_""".",0)
. D FORMWRIT("",2)
;new and set variables
N DIROUT,DUOUT,DTOUT,HBHCEXIT,HBHCICDNT
N HBHCRETV,HBHCXX,HBHCLEVEL
S HBHCRETV=""
S HBHCEXIT=0
S HBHCLEVEL=1,HBHCLVTXT(HBHCLEVEL)=HBHCTXT ;level 1 stores the original search string
; main loop
F Q:HBHCEXIT>0 D
. K HBHCICDY
. ;get the search string from the current level and call LEX API
. S HBHCICDY=$$DIAGSRCH^LEX10CS(HBHCLVTXT(HBHCLEVEL),.HBHCICDY,HBHCDATE,30)
. S:$O(HBHCICDY(" "),-1)>0 HBHCICDY=+HBHCICDY
. ; Nothing found
. I +HBHCICDY'>0 S HBHCEXIT=1 S HBHCXX=-1 Q
. ; display the list of items and ask the user to select the item from the list
. S HBHCXX=$$SEL^HBHCLKU2(.HBHCICDY,8)
. ; if ^ was entered
. ; if this is on the top level then quit
. I HBHCXX=-2,HBHCLEVEL'>1 S HBHCRETV=-3 S HBHCEXIT=1 Q
. ; if lower level then go one level up
. I HBHCXX=-2,HBHCLEVEL>1 S HBHCLEVEL=HBHCLEVEL-1 Q
. ; If timeout then quit
. I HBHCXX=-3 S HBHCRETV=-2 S HBHCEXIT=1 Q
. ; If not selected then quit
. I HBHCXX=-1 S HBHCRETV=-1 S HBHCEXIT=1 Q
. ; If ^^ then quit
. I HBHCXX=-5 S HBHCRETV=-3 S HBHCEXIT=1 Q
. ; if Code Found and Selected by the user save selection in HBHCRETV and quit
. I $P(HBHCXX,";")'="99:CAT" S HBHCRETV=HBHCXX S HBHCEXIT=1 Q
. ; If Category Found and Selected by the user:
. ; go to the next inner level
. ; change level number
. S HBHCLEVEL=HBHCLEVEL+1
. ; set the new level with the new search string
. ; and repeat
. S HBHCLVTXT(HBHCLEVEL)=$P($P($G(HBHCXX),"^"),";",2)
Q HBHCRETV
;
;---------
;ICD-9 lookup (FileMan lookup)
;Input parameters :
; HBHCSRCH - search string
; HBHCICDT - date of interest
;returns ICD-9 code selected by the user:
; IEN file #80;ICD code value^description
; or
; -1 if error like no selection made or search found nothing
; -2 if exit : ^ or ^^
; -3 if timed out
;Note: this API is not silent because the ICD lookup is not silent
FMICD9(HBHCSRCH,HBHCICDT) ;
N KEY,X,Y,DIC,HBHCCDS
;KEY must be newed as ICD lookup code doesn't kill it
S DIC="^ICD9(",DIC(0)="EQZ"
; Set screening of inactive codes!!
S HBHCCDS="ICD9"
S DIC("S")="I $$CSI^ICDEX(80,Y)=1"
; both X and Y should be set to the search string
S (X,Y)=HBHCSRCH
D ^DIC
I $G(Y) D Q Y
. I $P(Y,U,1)<0 D
. . S:$D(DUOUT) Y=-2 ;search aborted
. . S:$D(DTOUT) Y=-3 ;timed out
Q X
;
;---------
; Clean up environment and quit
CLEANUP ;
K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,%Y,DIWL,DIWR
Q
;
;---------
;ask YES/NO questions
;input parameters :
; HBHCDFLT- 0/null- not default, 1- yes, 2 -no
; HBHCPROM - prompt string
;returns
; 2 - no,
; 1 -yes,
; 0 - no answer
QUESTION(HBHCDFLT,HBHCPROM) ;
W:$L($G(HBHCPROM)) !,HBHCPROM
S %=$G(HBHCDFLT,2)
D YN^DICN
Q:%Y["^" -3
I %=2!(%=1) Q %
Q -2
;
;---------
;get search string
;input parameters :
; HBHCPRMT prompt text
; HBHCHLP1 "?" help text
; HBHCHLP2 "??" help text
; HBHCDFLT- default response
;returns piece1 ^ piece 2
; piece1:
; 0 if normal input
; or -1 if invalid data
; or -2 if time out
; or -3 if ^
; or -4 if user accepts default value
; or -5 if user enters "@"
; piece2: string entered by the user
SRCHSTR(HBHCPRMT,HBHCHLP1,HBHCHLP2,HBHCDFLT) ;
N DIR
S DIR("A")=HBHCPRMT
S DIR("?")=HBHCHLP1
S DIR("??")=HBHCHLP2
I $L($G(HBHCDFLT)) S DIR("B")=HBHCDFLT
S DIR(0)="FAOr^0:245"
D ^DIR
Q:$D(DTOUT) -2
Q:$D(DUOUT) -3
Q:X="@" -5
Q:Y["^" -3
Q:Y="" -1
Q:(($L($G(HBHCDFLT)))&(Y=HBHCDFLT)) -4 ;if user accepts default value then no need to validate it
Q 0_U_Y
;
;---------
;set parameters
;edit these hardcoded strings that are used for prompts, messages and so on to adjust them to your application's needs
;input parameters
; HBHCPAR - local array to sets and store string constants for your messages and prompts
; HBHCMODE - Admission or Discharge entry
; HBHCCS - Search coding system
SETPARAM(HBHCPAR,HBHCMODE,HBHCCS) ;
I HBHCMODE=1 S HBHCPAR("SEARCH_PROMPT")="PRIMARY DIAGNOSIS @ ADMISSION: " I 1
E I HBHCMODE=2 S HBHCPAR("SEARCH_PROMPT")="PRIMARY DIAGNOSIS @ DISCHARGE: " I 1
E S HBHCPAR("SEARCH_PROMPT")="Enter Diagnosis, a Code or a Code Fragment: "
I HBHCCS=1 D I 1
. S HBHCPAR("HELP ?")="^D HLPICD9^HBHCLKU1"
. S HBHCPAR("HELP ??")="^D HLPICD9^HBHCLKU1"
E I HBHCCS=30 D I 1
. S HBHCPAR("HELP ?")="^D HLPICD10^HBHCLKU1"
. S HBHCPAR("HELP ??")="^D HLPICD10^HBHCLKU1"
S HBHCPAR("WISH CONTINUE")="Do you wish to continue(Y/N)"
S HBHCPAR("EXCEEDS MESSAGE1")="Searching for """
S HBHCPAR("EXCEEDS MESSAGE2")=""" requires inspecting "
S HBHCPAR("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 HBHCPAR("DELETE?")=" SURE YOU WANT TO DELETE"
S HBHCPAR("ENTER MORE")=" Please enter at least the first two characters of the ICD-10 code or code"
S HBHCPAR("ENTER MORE2")=" description to start the search."
Q
;
;---------
; Look-up help for ICD-10
HLPICD10 ;
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
;
;---------
; Look-up help for ICD-9
HLPICD9 ;
N DIC,D,DIFORMAT,DZ
I $G(X)["??" D I 1
. W " This field represents patient's primary diagnosis at time of admission,"
. W !," referencing ICD Diagnosis (80) file entries."
. S DZ="??"
E D
. W " Answer with ICD diagnosis code, or diagnosis description, of patient's"
. W !," primary diagnosis at time of admission."
S D="B"
S DIC="^ICD9(",DIC(0)="IMEQXZ"
S DIC("S")="I $$CSI^ICDEX(80,Y)=1"
D DQ^DICQ
Q
;
;---------
;a wrapper for ^DIWP
;accumulates a text and then writes it to the device
;input parameters :
; X - text
; HBHCMODE:
; 0 - start
; 1 - accumulate
; 2 - write
;example:
;D FORMWRIT^HBHCLKU1("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^HBHCLKU1("some more text ",1)
;D FORMWRIT^HBHCLKU1("",2)
FORMWRIT(X,HBHCMODE) ;
N HBHCLI1
;if "start" mode
I HBHCMODE=0 K ^UTILITY($J,"W")
S DIWL=1,DIWR=79
I $L(X)>0 D ^DIWP
;if "write" mode
I HBHCMODE=2 D
. S HBHCLI1=0 F S HBHCLI1=$O(^UTILITY($J,"W",1,HBHCLI1)) Q:+HBHCLI1=0 W !,$G(^UTILITY($J,"W",1,HBHCLI1,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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCLKU1 19377 printed Dec 13, 2024@01:58:03 Page 2
HBHCLKU1 ;ALB/KG - DIAGNOSIS VALIDATION AND LOOK UP ;5/15/12
+1 ;;1.0;HOSPITAL BASED HOME CARE;**25**;NOV 01, 1993;Build 45
+2 ;
+3 ; This routine references the following supported ICRs:
+4 ; 5747 $$CODEC^ICDEX
+5 ; 5747 $$VSTD^ICDEX
+6 ; 5747 $$CSI^ICDEX
+7 ; 5747 $$SYS^ICDEX
+8 ; 5747 $$SAI^ICDEX
+9 ; 5681 $$DIAGSRCH^LEX10CS
+10 ; 5679 $$FREQ^LEXU
+11 ; 5679 $$MAX^LEXU
+12 ; 5773 FileMan lookup for file #80
+13 ;
+14 ;******************************************************************************
+15 ;******************************************************************************
+16 ; --- ROUTINE MODIFICATION LOG ---
+17 ;
+18 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+19 ;----------- ---------- ----------- ----------------------------------------
+20 ;HBH*1.0*25 APR 2012 K GUPTA Support for ICD-10 Coding System
+21 ;******************************************************************************
+22 ;******************************************************************************
+23 ;
+24 ;---------
+25 ;Diagnosis validation based on Evaluation/Admission date
+26 ;Called by:
+27 ; - PROMPT^HBHCADM
ADMDXVLD ;
+1 DO DXVLD(1,HBHCDFN)
+2 QUIT
+3 ;
+4 ;---------
+5 ;Diagnosis validation based on Discharge date
+6 ;Called by:
+7 ; - HBHC DISCHARGE Input Template
+8 ; - HBHC UPDATE DISCHARGE Input Template
+9 ;Input parameters:
+10 ; HBHCDFN1 - ^HBHC(631 IEN
DCDXVLD(HBHCDFN1) ;
+1 DO DXVLD(2,HBHCDFN1)
+2 QUIT
+3 ;
+4 ;---------
+5 ;Diagnosis validation based on date entry
+6 ;Input parameters:
+7 ; HBHCMODE - Admission or Discharge
+8 ; HBHCDFN1 - ^HBHC(631 IEN
DXVLD(HBHCMODE,HBHCDFN1) ;
+1 NEW HBHCDT,HBHCCURDXIEN
+2 ;date of interest
+3 ;admission date
IF HBHCMODE=1
SET HBHCDT=$PIECE($GET(^HBHC(631,HBHCDFN1,0)),U,18)
IF 1
+4 ;discharge date
IF '$TEST
IF HBHCMODE=2
SET HBHCDT=$PIECE($GET(^HBHC(631,HBHCDFN1,0)),U,40)
+5 SET HBHCCURDXIEN=$$GETDX(HBHCMODE,HBHCDFN1)
+6 ;check if dx's coding system is still valid based on date of interest
+7 ;if not valid then clear out old value
+8 IF HBHCCURDXIEN>0
IF '$$CHECKDX(HBHCCURDXIEN,HBHCDT)
DO SAVEDX(HBHCMODE,HBHCDFN1,"","")
+9 QUIT
+10 ;
+11 ;Diagnosis defaulting for Discharge
+12 ;Called by:
+13 ; - HBHC DISCHARGE Input Template
+14 ; - HBHC UPDATE DISCHARGE Input Template
+15 ;Input parameters:
+16 ; HBHCDFN1 - File #631 - patient identifier
+17 ;Output value:
+18 ; Admission dx if coding system matches with coding system of discharge date
+19 ;
DFLTDCDX(HBHCDFN1) ;
+1 NEW HBHCDCDX,HBHCADMDX,HBHCDCDT
+2 ; PRIMARY DIAGNOSIS @ DISCHARGE
SET HBHCDCDX=$PIECE($GET(^HBHC(631,HBHCDFN1,0)),U,47)
+3 IF HBHCDCDX=""
Begin DoDot:1
+4 ;admission dx
SET HBHCADMDX=$PIECE($GET(^HBHC(631,HBHCDFN1,0)),U,19)
+5 if HBHCADMDX=""
QUIT
+6 ;discharge date
SET HBHCDCDT=$PIECE($GET(^HBHC(631,HBHCDFN1,0)),U,40)
+7 ;default adm dx only if dx coding system matches with discharge date's coding system
+8 if $$CHECKDX(HBHCADMDX,HBHCDCDT)
SET HBHCDCDX=HBHCADMDX
End DoDot:1
+9 QUIT HBHCDCDX
+10 ;
+11 ;Diagnosis validation based on date of interest
+12 ;Input parameters:
+13 ; HBHCDX - Diagnosis IEN
+14 ; HBHCDT - Date of interest
+15 ;Output value:
+16 ; "1" - if coding system matches
+17 ; "" - error or if coding system don't match
+18 ;
CHECKDX(HBHCDX,HBHCDT) ;
+1 NEW HBHCDXCS,HBHCDTCS
+2 if (HBHCDX="")!(HBHCDT="")
QUIT ""
+3 ;determine coding system for dx
SET HBHCDXCS=$$CSI^ICDEX("80",HBHCDX)
+4 if HBHCDXCS=""
QUIT ""
+5 ;determine coding system for date
SET HBHCDTCS=$$SYS^ICDEX("80",HBHCDT,"I")
+6 if HBHCDTCS=-1
QUIT ""
+7 ;if two coding system matches
if HBHCDXCS=HBHCDTCS
QUIT "1"
+8 QUIT ""
+9 ;
+10 ;---------
+11 ;Diagnosis entry for Evaluation/Admission
+12 ;Called by:
+13 ; - PROMPT^HBHCADM
ADMDX ;
+1 DO ICD(1,HBHCDFN)
+2 QUIT
+3 ;
+4 ;---------
+5 ;Diagnosis entry for Discharge
+6 ;Called by:
+7 ; - HBHC DISCHARGE Input Template
+8 ; - HBHC UPDATE DISCHARGE Input Template
+9 ;Input parameters:
+10 ; HBHCDFN1 - ^HBHC(631 IEN
DCDX(HBHCDFN1) ;
+1 DO ICD(2,HBHCDFN1)
+2 QUIT
+3 ;
+4 ;---------
+5 ;Diagnosis entry
+6 ;Input parameters
+7 ; HBHCMODE - Admission or Discharge
+8 ; HBHCDFN1 - ^HBHC(631 IEN
ICD(HBHCMODE,HBHCDFN1) ;
+1 ;set standards variables, you might not need this if it was already done in your application
DO INITVARS
+2 NEW HBHCRETV,HBHCPARAM,HBHCDT,HBHCSYS,HBHCDFLT,HBHCCURDXIEN,HBHCQUIT,HBHCNEWDXIEN
+3 ;date of interest
+4 ;admission date
IF HBHCMODE=1
SET HBHCDT=$PIECE($GET(^HBHC(631,HBHCDFN1,0)),U,18)
IF 1
+5 ;discharge date
IF '$TEST
IF HBHCMODE=2
SET HBHCDT=$PIECE($GET(^HBHC(631,HBHCDFN1,0)),U,40)
+6 ;determine coding system based on the date of interest
SET HBHCSYS=$$SYS^ICDEX("80",HBHCDT,"I")
+7 ;settings
+8 DO SETPARAM(.HBHCPARAM,HBHCMODE,HBHCSYS)
+9 ;default response for the prompt
+10 SET HBHCDFLT=""
+11 SET HBHCCURDXIEN=+$$GETDX(HBHCMODE,HBHCDFN1)
+12 if HBHCCURDXIEN>0
SET HBHCDFLT=$$CODEC^ICDEX(80,HBHCCURDXIEN)_" "_$$VSTD^ICDEX(HBHCCURDXIEN,HBHCDT)
+13 SET HBHCQUIT=0
FOR
if HBHCQUIT=1
QUIT
Begin DoDot:1
+14 SET HBHCRETV=0
+15 ;run either ICD9 or ICD10 prompt/search/select logic
+16 ;ICD9 (1 is a pointer to the ICD-9 diagnosis system entry in the new file #80.4 )
+17 IF HBHCSYS=1
SET HBHCRETV=$$DIAG9(HBHCDT,HBHCDFLT,.HBHCPARAM)
IF 1
+18 ;ICD10 (30 is a pointer to the ICD-10 diagnosis system entry in the new file #80.4 )
+19 IF '$TEST
IF HBHCSYS=30
SET HBHCRETV=$$DIAG10(HBHCDT,HBHCDFLT,.HBHCPARAM)
+20 DO CLEANUP
+21 SET HBHCNEWDXIEN=$PIECE(HBHCRETV,";",1)
+22 ;if a new dx is selected
IF HBHCNEWDXIEN>0
DO SAVEDX(HBHCMODE,HBHCDFN1,HBHCNEWDXIEN,HBHCDT)
SET HBHCQUIT=1
QUIT
+23 ;Dx entry prompt: user pressed "enter" with no default, so quit dx entry and go to next prompt
IF HBHCNEWDXIEN=-1
SET HBHCQUIT=1
QUIT
+24 ;Dx entry prompt: timed out, so quit dx entry and quit entire admission entry
IF HBHCNEWDXIEN=-2
SET Y=0
SET HBHCQUIT=1
QUIT
+25 ;Dx entry prompt: user entered "^", so quit entry and quit entire admission entry
IF HBHCNEWDXIEN=-3
SET Y=0
SET HBHCQUIT=1
QUIT
+26 ;Dx entry prompt: user pressed "enter" with default value
IF HBHCNEWDXIEN=-4
SET HBHCQUIT=1
QUIT
+27 ;Dx entry prompt: user entered "@", so ask Y/N question to user
IF HBHCNEWDXIEN=-5
Begin DoDot:2
+28 IF HBHCCURDXIEN'>0
SET HBHCQUIT=0
QUIT
+29 IF $$QUESTION("",HBHCPARAM("DELETE?"))=1
Begin DoDot:3
+30 DO SAVEDX(HBHCMODE,HBHCDFN1,"",HBHCDT)
+31 SET HBHCQUIT=1
End DoDot:3
IF 1
+32 IF '$TEST
SET HBHCQUIT=0
End DoDot:2
QUIT
+33 ;Dx search prompt: timed out, so quit dx entry and quit entire admission entry
IF HBHCNEWDXIEN=-6
SET Y=0
SET HBHCQUIT=1
QUIT
+34 ;Dx search prompt: user entered "^" or "^^", so quit search, ask dx entry again
IF HBHCNEWDXIEN=-7
SET HBHCQUIT=0
QUIT
+35 ;Dx search prompt: user selected nothing, so ask dx entry again
IF HBHCNEWDXIEN=-8
SET HBHCQUIT=0
QUIT
+36 ;Dx search prompt: in ICD10 if the user answered NO when warned about lot of result found
IF HBHCNEWDXIEN=-9
SET HBHCQUIT=0
QUIT
+37 ;Dx search prompt: no data found when user searched, so ask dx entry again
IF HBHCNEWDXIEN=""
WRITE " No data found",!
SET HBHCQUIT=0
QUIT
End DoDot:1
+38 QUIT
+39 ;
+40 ;---------
+41 ;Save Admission or Discharge diagnosis
+42 ;Input parameters
+43 ; HBHCMODE - Admission or Discharge
+44 ; HBHCDFN1 - ^HBHC(631 IEN
+45 ; HBHCDXIEN - Diagnosis IEN
+46 ; HBHCDT - Date of interest
SAVEDX(HBHCMODE,HBHCDFN1,HBHCDXIEN,HBHCDT) ;
+1 NEW HBHCPC
+2 IF HBHCMODE=1
SET HBHCPC=19
IF 1
+3 IF '$TEST
IF HBHCMODE=2
SET HBHCPC=47
+4 SET $PIECE(^HBHC(631,HBHCDFN1,0),U,HBHCPC)=HBHCDXIEN
+5 if HBHCDXIEN>0
WRITE " "_$$CODEC^ICDEX(80,HBHCDXIEN)_" "_$$VSTD^ICDEX(HBHCDXIEN,HBHCDT)
+6 QUIT
+7 ;
+8 ;---------
+9 ;Get Admission or Discharge diagnosis
+10 ;Input parameters
+11 ; HBHCMODE - Admission or Discharge
+12 ; HBHCDFN1 - ^HBHC(631 IEN
GETDX(HBHCMODE,HBHCDFN1) ;
+1 NEW HBHCPC
+2 IF HBHCMODE=1
SET HBHCPC=19
IF 1
+3 IF '$TEST
IF HBHCMODE=2
SET HBHCPC=47
+4 QUIT $PIECE($GET(^HBHC(631,HBHCDFN1,0)),U,HBHCPC)
+5 ;
+6 ;---------
+7 ;The entry point for ICD-10 diagnosis search functionality
+8 ;can be called from applications directly
+9 ;input parameters :
+10 ; HBHCDT - date of interest (Fileman format)
+11 ; HBHCDFLT - default values for the search string (can be a code by default)
+12 ; HBHCPARAM - parameters/string constants (see SETPARAM for details)
+13 ;returns ICD-10 code selected by the user:
+14 ; IEN file #80;ICD code value;IEN file #757.01^description
+15 ; results
+16 ; or -1 Dx entry prompt: if invalid data(press enter)
+17 ; or -2 Dx entry prompt: if time out
+18 ; or -3 Dx entry prompt: if ^ or ^^
+19 ; or -4 Dx entry prompt: if no changes to the default value
+20 ; or -5 Dx entry prompt: if user enters "@"
+21 ; or -6 Dx search prompt: if timed out
+22 ; or -7 Dx search prompt: search was aborted by user by entering "^" or "^^"
+23 ; or -8 Dx search prompt: user selected nothing
+24 ; or -9 Dx search prompt: if the user answered NO for the question "Do you wish to continue(Y/N)?"
+25 ; or "" Dx search prompt: if not found
+26 ;
DIAG10(HBHCDT,HBHCDFLT,HBHCPARAM) ;
+1 NEW HBHCINP,HBHCRETV
+2 FOR
Begin DoDot:1
+3 SET HBHCINP=$$SRCHSTR(HBHCPARAM("SEARCH_PROMPT"),HBHCPARAM("HELP ?"),HBHCPARAM("HELP ??"),HBHCDFLT)
+4 ;user should enter at least 2 characters
IF HBHCINP'<0
IF $LENGTH($PIECE(HBHCINP,U,2))'>1
WRITE !!,HBHCPARAM("ENTER MORE")
if $LENGTH(HBHCPARAM("ENTER MORE2"))>0
WRITE !,HBHCPARAM("ENTER MORE2")
WRITE !
End DoDot:1
if HBHCINP<0!($LENGTH($PIECE(HBHCINP,U,2))>1)
QUIT
+5 IF HBHCINP<0
QUIT +HBHCINP
+6 SET HBHCRETV=$$LEXICD10($PIECE(HBHCINP,U,2),HBHCDT,.HBHCPARAM)
+7 ;non selection
IF HBHCRETV=-1
QUIT -8
+8 ;search timed out
IF HBHCRETV=-2
QUIT -6
+9 ;search was aborted by user by entering "^" or "^^"
IF HBHCRETV=-3
QUIT -7
+10 ;user answered NO for the question "Do you wish to continue(Y/N)?" when search returned lot of values
IF HBHCRETV=-4
QUIT -9
+11 QUIT HBHCRETV
+12 ;
+13 ;---------
+14 ;The entry point for ICD-9 FileMan type (^DIC) diagnosis search functionality
+15 ;can be called from applications directly
+16 ;input parameters :
+17 ; HBHCDT - date of interest
+18 ; HBHCDFLT - default values for the search string (can be a code by default)
+19 ; HBHCPARAM - parameters/string constants (see SETPARAM for details)
+20 ;returns ICD-9 code selected by the user:
+21 ; IEN file #80;ICD code value^description
+22 ; or -1 Dx entry prompt: if invalid data(press enter)
+23 ; or -2 Dx entry prompt: if time out
+24 ; or -3 Dx entry prompt: if ^ or ^^
+25 ; or -4 Dx entry prompt: if no changes to the default value
+26 ; or -5 Dx entry prompt: if user enters "@"
+27 ; or -6 Dx search prompt: if time out
+28 ; or -7 Dx search prompt: search was aborted by user by entering "^" or "^^"
+29 ; or -8 Dx search prompt: user selected nothing
+30 ; or "" Dx search prompt: if not found
+31 ;
DIAG9(HBHCDT,HBHCDFLT,HBHCPARAM) ;
+1 NEW HBHCINP,HBHCRETV
+2 SET HBHCINP=$$SRCHSTR(HBHCPARAM("SEARCH_PROMPT"),HBHCPARAM("HELP ?"),HBHCPARAM("HELP ??"),HBHCDFLT)
+3 IF +HBHCINP<0
QUIT +HBHCINP
+4 SET HBHCRETV=$$FMICD9($PIECE(HBHCINP,U,2),HBHCDT)
+5 SET HBHCRETV=$PIECE(HBHCRETV,U,1)
+6 ;search timed-out
IF HBHCRETV=-3
QUIT -6
+7 ;search was aborted by user by entering "^" or "^^"
IF HBHCRETV=-2
QUIT -7
+8 ;user selected nothing or no values found
IF HBHCRETV=-1
QUIT -8
+9 QUIT HBHCRETV
+10 ;
+11 ;---------
+12 ;The entry point for ICD-10 diagnosis search functionality
+13 ;input parameters :
+14 ; HBHCTXT - search string
+15 ; HBHCDATE - date of interest
+16 ; HBHCPAR - array with text messages and other string constants
+17 ;returns ICD-10 code selected by the user:
+18 ; IEN file #80;ICD code value^description
+19 ; or
+20 ; "" if not found
+21 ; -1 if non selection
+22 ; -2 if search timed out
+23 ; -3 if search was aborted by user by entering "^" or "^^"
+24 ; -4 if user answered NO for the question "Do you wish to continue(Y/N)?" when search returned lot of values
+25 ;
LEXICD10(HBHCTXT,HBHCDATE,HBHCPAR) ; ICD-10 Search
+1 NEW HBHCLVTXT
+2 ;parameters check
+3 SET HBHCDATE=+$GET(HBHCDATE)
+4 IF HBHCDATE'?7N
QUIT -1
+5 SET HBHCTXT=$GET(HBHCTXT)
+6 if '$LENGTH(HBHCTXT)
QUIT -1
+7 NEW HBHCNUMB
+8 SET HBHCNUMB=$$FREQ^LEXU(HBHCTXT)
+9 IF HBHCNUMB>$$MAX^LEXU(30)
Begin DoDot:1
+10 DO FORMWRIT(HBHCPAR("EXCEEDS MESSAGE1")_HBHCTXT_HBHCPAR("EXCEEDS MESSAGE2")_HBHCNUMB_HBHCPAR("EXCEEDS MESSAGE3")_HBHCTXT_""".",0)
+11 DO FORMWRIT("",2)
End DoDot:1
IF $$QUESTION("N",HBHCPARAM("WISH CONTINUE"))'=1
QUIT -4
+12 ;new and set variables
+13 NEW DIROUT,DUOUT,DTOUT,HBHCEXIT,HBHCICDNT
+14 NEW HBHCRETV,HBHCXX,HBHCLEVEL
+15 SET HBHCRETV=""
+16 SET HBHCEXIT=0
+17 ;level 1 stores the original search string
SET HBHCLEVEL=1
SET HBHCLVTXT(HBHCLEVEL)=HBHCTXT
+18 ; main loop
+19 FOR
if HBHCEXIT>0
QUIT
Begin DoDot:1
+20 KILL HBHCICDY
+21 ;get the search string from the current level and call LEX API
+22 SET HBHCICDY=$$DIAGSRCH^LEX10CS(HBHCLVTXT(HBHCLEVEL),.HBHCICDY,HBHCDATE,30)
+23 if $ORDER(HBHCICDY(" "),-1)>0
SET HBHCICDY=+HBHCICDY
+24 ; Nothing found
+25 IF +HBHCICDY'>0
SET HBHCEXIT=1
SET HBHCXX=-1
QUIT
+26 ; display the list of items and ask the user to select the item from the list
+27 SET HBHCXX=$$SEL^HBHCLKU2(.HBHCICDY,8)
+28 ; if ^ was entered
+29 ; if this is on the top level then quit
+30 IF HBHCXX=-2
IF HBHCLEVEL'>1
SET HBHCRETV=-3
SET HBHCEXIT=1
QUIT
+31 ; if lower level then go one level up
+32 IF HBHCXX=-2
IF HBHCLEVEL>1
SET HBHCLEVEL=HBHCLEVEL-1
QUIT
+33 ; If timeout then quit
+34 IF HBHCXX=-3
SET HBHCRETV=-2
SET HBHCEXIT=1
QUIT
+35 ; If not selected then quit
+36 IF HBHCXX=-1
SET HBHCRETV=-1
SET HBHCEXIT=1
QUIT
+37 ; If ^^ then quit
+38 IF HBHCXX=-5
SET HBHCRETV=-3
SET HBHCEXIT=1
QUIT
+39 ; if Code Found and Selected by the user save selection in HBHCRETV and quit
+40 IF $PIECE(HBHCXX,";")'="99:CAT"
SET HBHCRETV=HBHCXX
SET HBHCEXIT=1
QUIT
+41 ; If Category Found and Selected by the user:
+42 ; go to the next inner level
+43 ; change level number
+44 SET HBHCLEVEL=HBHCLEVEL+1
+45 ; set the new level with the new search string
+46 ; and repeat
+47 SET HBHCLVTXT(HBHCLEVEL)=$PIECE($PIECE($GET(HBHCXX),"^"),";",2)
End DoDot:1
+48 QUIT HBHCRETV
+49 ;
+50 ;---------
+51 ;ICD-9 lookup (FileMan lookup)
+52 ;Input parameters :
+53 ; HBHCSRCH - search string
+54 ; HBHCICDT - date of interest
+55 ;returns ICD-9 code selected by the user:
+56 ; IEN file #80;ICD code value^description
+57 ; or
+58 ; -1 if error like no selection made or search found nothing
+59 ; -2 if exit : ^ or ^^
+60 ; -3 if timed out
+61 ;Note: this API is not silent because the ICD lookup is not silent
FMICD9(HBHCSRCH,HBHCICDT) ;
+1 NEW KEY,X,Y,DIC,HBHCCDS
+2 ;KEY must be newed as ICD lookup code doesn't kill it
+3 SET DIC="^ICD9("
SET DIC(0)="EQZ"
+4 ; Set screening of inactive codes!!
+5 SET HBHCCDS="ICD9"
+6 SET DIC("S")="I $$CSI^ICDEX(80,Y)=1"
+7 ; both X and Y should be set to the search string
+8 SET (X,Y)=HBHCSRCH
+9 DO ^DIC
+10 IF $GET(Y)
Begin DoDot:1
+11 IF $PIECE(Y,U,1)<0
Begin DoDot:2
+12 ;search aborted
if $DATA(DUOUT)
SET Y=-2
+13 ;timed out
if $DATA(DTOUT)
SET Y=-3
End DoDot:2
End DoDot:1
QUIT Y
+14 QUIT X
+15 ;
+16 ;---------
+17 ; Clean up environment and quit
CLEANUP ;
+1 KILL %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,%Y,DIWL,DIWR
+2 QUIT
+3 ;
+4 ;---------
+5 ;ask YES/NO questions
+6 ;input parameters :
+7 ; HBHCDFLT- 0/null- not default, 1- yes, 2 -no
+8 ; HBHCPROM - prompt string
+9 ;returns
+10 ; 2 - no,
+11 ; 1 -yes,
+12 ; 0 - no answer
QUESTION(HBHCDFLT,HBHCPROM) ;
+1 if $LENGTH($GET(HBHCPROM))
WRITE !,HBHCPROM
+2 SET %=$GET(HBHCDFLT,2)
+3 DO YN^DICN
+4 if %Y["^"
QUIT -3
+5 IF %=2!(%=1)
QUIT %
+6 QUIT -2
+7 ;
+8 ;---------
+9 ;get search string
+10 ;input parameters :
+11 ; HBHCPRMT prompt text
+12 ; HBHCHLP1 "?" help text
+13 ; HBHCHLP2 "??" help text
+14 ; HBHCDFLT- default response
+15 ;returns piece1 ^ piece 2
+16 ; piece1:
+17 ; 0 if normal input
+18 ; or -1 if invalid data
+19 ; or -2 if time out
+20 ; or -3 if ^
+21 ; or -4 if user accepts default value
+22 ; or -5 if user enters "@"
+23 ; piece2: string entered by the user
SRCHSTR(HBHCPRMT,HBHCHLP1,HBHCHLP2,HBHCDFLT) ;
+1 NEW DIR
+2 SET DIR("A")=HBHCPRMT
+3 SET DIR("?")=HBHCHLP1
+4 SET DIR("??")=HBHCHLP2
+5 IF $LENGTH($GET(HBHCDFLT))
SET DIR("B")=HBHCDFLT
+6 SET DIR(0)="FAOr^0:245"
+7 DO ^DIR
+8 if $DATA(DTOUT)
QUIT -2
+9 if $DATA(DUOUT)
QUIT -3
+10 if X="@"
QUIT -5
+11 if Y["^"
QUIT -3
+12 if Y=""
QUIT -1
+13 ;if user accepts default value then no need to validate it
if (($LENGTH($GET(HBHCDFLT)))&(Y=HBHCDFLT))
QUIT -4
+14 QUIT 0_U_Y
+15 ;
+16 ;---------
+17 ;set parameters
+18 ;edit these hardcoded strings that are used for prompts, messages and so on to adjust them to your application's needs
+19 ;input parameters
+20 ; HBHCPAR - local array to sets and store string constants for your messages and prompts
+21 ; HBHCMODE - Admission or Discharge entry
+22 ; HBHCCS - Search coding system
SETPARAM(HBHCPAR,HBHCMODE,HBHCCS) ;
+1 IF HBHCMODE=1
SET HBHCPAR("SEARCH_PROMPT")="PRIMARY DIAGNOSIS @ ADMISSION: "
IF 1
+2 IF '$TEST
IF HBHCMODE=2
SET HBHCPAR("SEARCH_PROMPT")="PRIMARY DIAGNOSIS @ DISCHARGE: "
IF 1
+3 IF '$TEST
SET HBHCPAR("SEARCH_PROMPT")="Enter Diagnosis, a Code or a Code Fragment: "
+4 IF HBHCCS=1
Begin DoDot:1
+5 SET HBHCPAR("HELP ?")="^D HLPICD9^HBHCLKU1"
+6 SET HBHCPAR("HELP ??")="^D HLPICD9^HBHCLKU1"
End DoDot:1
IF 1
+7 IF '$TEST
IF HBHCCS=30
Begin DoDot:1
+8 SET HBHCPAR("HELP ?")="^D HLPICD10^HBHCLKU1"
+9 SET HBHCPAR("HELP ??")="^D HLPICD10^HBHCLKU1"
End DoDot:1
IF 1
+10 SET HBHCPAR("WISH CONTINUE")="Do you wish to continue(Y/N)"
+11 SET HBHCPAR("EXCEEDS MESSAGE1")="Searching for """
+12 SET HBHCPAR("EXCEEDS MESSAGE2")=""" requires inspecting "
+13 SET HBHCPAR("EXCEEDS MESSAGE3")=" records to determine if they match the search criteria. This could take quite some time. Suggest refining the search by further specifying """
+14 SET HBHCPAR("DELETE?")=" SURE YOU WANT TO DELETE"
+15 SET HBHCPAR("ENTER MORE")=" Please enter at least the first two characters of the ICD-10 code or code"
+16 SET HBHCPAR("ENTER MORE2")=" description to start the search."
+17 QUIT
+18 ;
+19 ;---------
+20 ; Look-up help for ICD-10
HLPICD10 ;
+1 IF $GET(X)["???"
DO INPHLP3
QUIT
+2 IF $GET(X)["??"
DO INPHLP2
QUIT
+3 WRITE !," Enter code or ""text"" for more information."
QUIT
+4 QUIT
+5 ;-----------
+6 ; Look-up help for ??
INPHLP2 ;
+1 WRITE !," Enter a ""free text"" term or part of a term such as ""femur fracture""."
+2 WRITE !!," or "
+3 WRITE !!," Enter a ""classification code"" (ICD/CPT etc) to find the single term"
+4 WRITE !," associated with the code."
+5 WRITE !!," or "
+6 WRITE !!," Enter a ""partial code"". Include the decimal when a search criterion"
+7 WRITE !," includes 3 characters or more for code searches."
+8 QUIT
+9 ;--------
+10 ; Look-up help for ???
INPHLP3 ;
+1 WRITE !," Number of Code Matches"
+2 WRITE !," ----------------------"
+3 WRITE !!," The ICD-10 Diagnosis Code search will show the user the number of matches"
+4 WRITE !," found, indicate if additional characters in ICD code exist, and the number"
+5 WRITE !," of codes within the category or subcategory that are available for selection."
+6 WRITE !," For example:"
+7 WRITE !!," 14 matches found"
+8 WRITE !!," M91. - Juvenile osteochondrosis of hip and pelvis (19)"
+9 WRITE !!," This indicates that 14 unique matches or matching groups have been found"
+10 WRITE !," and will be displayed."
+11 WRITE !!," M91. - the ""-"" indicates that there are additional characters that specify"
+12 WRITE !," unique ICD-10 codes available."
+13 WRITE !!," (19) Indicates that there are 19 additional ICD-10 codes in the M91 ""family"""
+14 WRITE !," that are possible selections."
+15 QUIT
+16 ;
+17 ;---------
+18 ; Look-up help for ICD-9
HLPICD9 ;
+1 NEW DIC,D,DIFORMAT,DZ
+2 IF $GET(X)["??"
Begin DoDot:1
+3 WRITE " This field represents patient's primary diagnosis at time of admission,"
+4 WRITE !," referencing ICD Diagnosis (80) file entries."
+5 SET DZ="??"
End DoDot:1
IF 1
+6 IF '$TEST
Begin DoDot:1
+7 WRITE " Answer with ICD diagnosis code, or diagnosis description, of patient's"
+8 WRITE !," primary diagnosis at time of admission."
End DoDot:1
+9 SET D="B"
+10 SET DIC="^ICD9("
SET DIC(0)="IMEQXZ"
+11 SET DIC("S")="I $$CSI^ICDEX(80,Y)=1"
+12 DO DQ^DICQ
+13 QUIT
+14 ;
+15 ;---------
+16 ;a wrapper for ^DIWP
+17 ;accumulates a text and then writes it to the device
+18 ;input parameters :
+19 ; X - text
+20 ; HBHCMODE:
+21 ; 0 - start
+22 ; 1 - accumulate
+23 ; 2 - write
+24 ;example:
+25 ;D FORMWRIT^HBHCLKU1("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)
+26 ;D FORMWRIT^HBHCLKU1("some more text ",1)
+27 ;D FORMWRIT^HBHCLKU1("",2)
FORMWRIT(X,HBHCMODE) ;
+1 NEW HBHCLI1
+2 ;if "start" mode
+3 IF HBHCMODE=0
KILL ^UTILITY($JOB,"W")
+4 SET DIWL=1
SET DIWR=79
+5 IF $LENGTH(X)>0
DO ^DIWP
+6 ;if "write" mode
+7 IF HBHCMODE=2
Begin DoDot:1
+8 SET HBHCLI1=0
FOR
SET HBHCLI1=$ORDER(^UTILITY($JOB,"W",1,HBHCLI1))
if +HBHCLI1=0
QUIT
WRITE !,$GET(^UTILITY($JOB,"W",1,HBHCLI1,0))
+9 KILL ^UTILITY($JOB,"W")
End DoDot:1
+10 QUIT
+11 ;
+12 ;---------
+13 ;Initialize variables if you need , your application most likely already has this
INITVARS ;
+1 DO HOME^%ZIS
+2 if $GET(DT)=0
SET DT=$$DT^XLFDT
+3 QUIT
+4 ;
