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

HBHCLKU1.m

Go to the documentation of this file. 
  1. HBHCLKU1 ;ALB/KG - DIAGNOSIS VALIDATION AND LOOK UP ;5/15/12
  1.  ;;1.0;HOSPITAL BASED HOME CARE;**25**;NOV 01, 1993;Build 45
  1.  ;
  1.  ; This routine references the following supported ICRs:
  1.  ; 5747    $$CODEC^ICDEX
  1.  ; 5747    $$VSTD^ICDEX
  1.  ; 5747    $$CSI^ICDEX
  1.  ; 5747    $$SYS^ICDEX
  1.  ; 5747    $$SAI^ICDEX
  1.  ; 5681    $$DIAGSRCH^LEX10CS
  1.  ; 5679    $$FREQ^LEXU
  1.  ; 5679    $$MAX^LEXU
  1.  ; 5773    FileMan lookup for file #80
  1.  ;
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;                       --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;HBH*1.0*25   APR  2012   K GUPTA      Support for ICD-10 Coding System
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;
  1.  ;---------
  1.  ;Diagnosis validation based on Evaluation/Admission date
  1.  ;Called by:
  1.  ; - PROMPT^HBHCADM
  1. ADMDXVLD ;
  1.  D DXVLD(1,HBHCDFN)
  1.  Q
  1.  ;
  1.  ;---------
  1.  ;Diagnosis validation based on Discharge date
  1.  ;Called by:
  1.  ; - HBHC DISCHARGE Input Template
  1.  ; - HBHC UPDATE DISCHARGE Input Template
  1.  ;Input parameters:
  1.  ; HBHCDFN1  - ^HBHC(631 IEN
  1. DCDXVLD(HBHCDFN1) ;
  1.  D DXVLD(2,HBHCDFN1)
  1.  Q
  1.  ;
  1.  ;---------
  1.  ;Diagnosis validation based on date entry
  1.  ;Input parameters:
  1.  ; HBHCMODE - Admission or Discharge
  1.  ; HBHCDFN1  - ^HBHC(631 IEN
  1. DXVLD(HBHCMODE,HBHCDFN1) ;
  1.  N HBHCDT,HBHCCURDXIEN
  1.  ;date of interest
  1.  I HBHCMODE=1 S HBHCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,18) I 1  ;admission date
  1.  E  I HBHCMODE=2 S HBHCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,40)  ;discharge date
  1.  S HBHCCURDXIEN=$$GETDX(HBHCMODE,HBHCDFN1)
  1.  ;check if dx's coding system is still valid based on date of interest
  1.  ;if not valid then clear out old value
  1.  I HBHCCURDXIEN>0,'$$CHECKDX(HBHCCURDXIEN,HBHCDT) D SAVEDX(HBHCMODE,HBHCDFN1,"","")
  1.  Q
  1.  ;
  1.  ;Diagnosis defaulting for Discharge
  1.  ;Called by:
  1.  ; - HBHC DISCHARGE Input Template
  1.  ; - HBHC UPDATE DISCHARGE Input Template
  1.  ;Input parameters:
  1.  ; HBHCDFN1 - File #631 - patient identifier
  1.  ;Output value:
  1.  ; Admission dx if coding system matches with coding system of discharge date
  1.  ;
  1. DFLTDCDX(HBHCDFN1) ;
  1.  N HBHCDCDX,HBHCADMDX,HBHCDCDT
  1.  S HBHCDCDX=$P($G(^HBHC(631,HBHCDFN1,0)),U,47) ; PRIMARY DIAGNOSIS @ DISCHARGE
  1.  I HBHCDCDX="" D
  1.  . S HBHCADMDX=$P($G(^HBHC(631,HBHCDFN1,0)),U,19)  ;admission dx
  1.  . Q:HBHCADMDX=""
  1.  . S HBHCDCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,40)  ;discharge date
  1.  . ;default adm dx only if dx coding system matches with discharge date's coding system
  1.  . S:$$CHECKDX(HBHCADMDX,HBHCDCDT) HBHCDCDX=HBHCADMDX
  1.  Q HBHCDCDX
  1.  ;
  1.  ;Diagnosis validation based on date of interest
  1.  ;Input parameters:
  1.  ; HBHCDX - Diagnosis IEN
  1.  ; HBHCDT - Date of interest
  1.  ;Output value:
  1.  ; "1" - if coding system matches
  1.  ; ""  - error or if coding system don't match
  1.  ;
  1. CHECKDX(HBHCDX,HBHCDT) ;
  1.  N HBHCDXCS,HBHCDTCS
  1.  Q:(HBHCDX="")!(HBHCDT="") ""
  1.  S HBHCDXCS=$$CSI^ICDEX("80",HBHCDX)  ;determine coding system for dx
  1.  Q:HBHCDXCS="" ""
  1.  S HBHCDTCS=$$SYS^ICDEX("80",HBHCDT,"I")  ;determine coding system for date
  1.  Q:HBHCDTCS=-1 ""
  1.  Q:HBHCDXCS=HBHCDTCS "1"  ;if two coding system matches
  1.  Q ""
  1.  ;
  1.  ;---------
  1.  ;Diagnosis entry for Evaluation/Admission
  1.  ;Called by:
  1.  ; - PROMPT^HBHCADM
  1. ADMDX ;
  1.  D ICD(1,HBHCDFN)
  1.  Q
  1.  ;
  1.  ;---------
  1.  ;Diagnosis entry for Discharge
  1.  ;Called by:
  1.  ; - HBHC DISCHARGE Input Template
  1.  ; - HBHC UPDATE DISCHARGE Input Template
  1.  ;Input parameters:
  1.  ; HBHCDFN1  - ^HBHC(631 IEN
  1. DCDX(HBHCDFN1) ;
  1.  D ICD(2,HBHCDFN1)
  1.  Q
  1.  ;
  1.  ;---------
  1.  ;Diagnosis entry
  1.  ;Input parameters
  1.  ; HBHCMODE - Admission or Discharge
  1.  ; HBHCDFN1  - ^HBHC(631 IEN
  1. ICD(HBHCMODE,HBHCDFN1) ;
  1.  D INITVARS ;set standards variables, you might not need this if it was already done in your application  
  1.  N HBHCRETV,HBHCPARAM,HBHCDT,HBHCSYS,HBHCDFLT,HBHCCURDXIEN,HBHCQUIT,HBHCNEWDXIEN
  1.  ;date of interest
  1.  I HBHCMODE=1 S HBHCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,18) I 1  ;admission date
  1.  E  I HBHCMODE=2 S HBHCDT=$P($G(^HBHC(631,HBHCDFN1,0)),U,40)   ;discharge date
  1.  S HBHCSYS=$$SYS^ICDEX("80",HBHCDT,"I")  ;determine coding system based on the date of interest
  1.  ;settings
  1.  D SETPARAM(.HBHCPARAM,HBHCMODE,HBHCSYS)
  1.  ;default response for the prompt
  1.  S HBHCDFLT=""
  1.  S HBHCCURDXIEN=+$$GETDX(HBHCMODE,HBHCDFN1)
  1.  S:HBHCCURDXIEN>0 HBHCDFLT=$$CODEC^ICDEX(80,HBHCCURDXIEN)_"  "_$$VSTD^ICDEX(HBHCCURDXIEN,HBHCDT)
  1.  S HBHCQUIT=0 F  Q:HBHCQUIT=1  D
  1.  . S HBHCRETV=0
  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 HBHCSYS=1 S HBHCRETV=$$DIAG9(HBHCDT,HBHCDFLT,.HBHCPARAM) I 1
  1.  . ;ICD10 (30 is a pointer to the ICD-10 diagnosis system entry in the new file #80.4 )
  1.  . E  I HBHCSYS=30 S HBHCRETV=$$DIAG10(HBHCDT,HBHCDFLT,.HBHCPARAM)
  1.  . D CLEANUP
  1.  . S HBHCNEWDXIEN=$P(HBHCRETV,";",1)
  1.  . I HBHCNEWDXIEN>0 D SAVEDX(HBHCMODE,HBHCDFN1,HBHCNEWDXIEN,HBHCDT) S HBHCQUIT=1 Q   ;if a new dx is selected
  1.  . 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
  1.  . I HBHCNEWDXIEN=-2 S Y=0,HBHCQUIT=1 Q  ;Dx entry prompt: timed out, so quit dx entry and quit entire admission entry
  1.  . I HBHCNEWDXIEN=-3 S Y=0,HBHCQUIT=1 Q  ;Dx entry prompt: user entered "^", so quit entry and quit entire admission entry
  1.  . I HBHCNEWDXIEN=-4 S HBHCQUIT=1 Q      ;Dx entry prompt: user pressed "enter" with default value
  1.  . I HBHCNEWDXIEN=-5 D  Q                ;Dx entry prompt: user entered "@", so ask Y/N question to user
  1.  . . I HBHCCURDXIEN'>0 S HBHCQUIT=0 Q
  1.  . . I $$QUESTION("",HBHCPARAM("DELETE?"))=1 D  I 1
  1.  . . . D SAVEDX(HBHCMODE,HBHCDFN1,"",HBHCDT)
  1.  . . . S HBHCQUIT=1
  1.  . . E  S HBHCQUIT=0
  1.  . I HBHCNEWDXIEN=-6 S Y=0,HBHCQUIT=1 Q  ;Dx search prompt: timed out, so quit dx entry and quit entire admission entry
  1.  . I HBHCNEWDXIEN=-7 S HBHCQUIT=0 Q      ;Dx search prompt: user entered "^" or "^^", so quit search, ask dx entry again
  1.  . I HBHCNEWDXIEN=-8 S HBHCQUIT=0 Q      ;Dx search prompt: user selected nothing, so ask dx entry again
  1.  . I HBHCNEWDXIEN=-9 S HBHCQUIT=0 Q      ;Dx search prompt: in ICD10 if the user answered NO when warned about lot of result found
  1.  . I HBHCNEWDXIEN="" W "  No data found",! S HBHCQUIT=0 Q  ;Dx search prompt: no data found when user searched, so ask dx entry again
  1.  Q
  1.  ;
  1.  ;---------
  1.  ;Save Admission or Discharge diagnosis
  1.  ;Input parameters
  1.  ; HBHCMODE  - Admission or Discharge
  1.  ; HBHCDFN1   - ^HBHC(631 IEN
  1.  ; HBHCDXIEN - Diagnosis IEN
  1.  ; HBHCDT    - Date of interest
  1. SAVEDX(HBHCMODE,HBHCDFN1,HBHCDXIEN,HBHCDT) ;
  1.  N HBHCPC
  1.  I HBHCMODE=1 S HBHCPC=19 I 1
  1.  E  I HBHCMODE=2 S HBHCPC=47
  1.  S $P(^HBHC(631,HBHCDFN1,0),U,HBHCPC)=HBHCDXIEN
  1.  W:HBHCDXIEN>0 "  "_$$CODEC^ICDEX(80,HBHCDXIEN)_"  "_$$VSTD^ICDEX(HBHCDXIEN,HBHCDT)
  1.  Q
  1.  ;
  1.  ;---------
  1.  ;Get Admission or Discharge diagnosis
  1.  ;Input parameters
  1.  ; HBHCMODE  - Admission or Discharge
  1.  ; HBHCDFN1   - ^HBHC(631 IEN
  1. GETDX(HBHCMODE,HBHCDFN1) ;
  1.  N HBHCPC
  1.  I HBHCMODE=1 S HBHCPC=19 I 1
  1.  E  I HBHCMODE=2 S HBHCPC=47
  1.  Q $P($G(^HBHC(631,HBHCDFN1,0)),U,HBHCPC)
  1.  ;
  1.  ;---------
  1.  ;The entry point for ICD-10 diagnosis search functionality
  1.  ;can be called from applications directly
  1.  ;input parameters :
  1.  ; HBHCDT - date of interest (Fileman format)
  1.  ; HBHCDFLT - default values for the search string (can be a code by default)
  1.  ; HBHCPARAM - 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 Dx entry prompt: if invalid data(press enter)
  1.  ; or -2 Dx entry prompt: if time out
  1.  ; or -3 Dx entry prompt: if ^ or ^^
  1.  ; or -4 Dx entry prompt: if no changes to the default value
  1.  ; or -5 Dx entry prompt: if user enters "@"
  1.  ; or -6 Dx search prompt: if timed out
  1.  ; or -7 Dx search prompt: search was aborted by user by entering "^" or "^^"
  1.  ; or -8 Dx search prompt: user selected nothing
  1.  ; or -9 Dx search prompt: if the user answered NO for the question "Do you wish to continue(Y/N)?"
  1.  ; or "" Dx search prompt: if not found
  1.  ; 
  1. DIAG10(HBHCDT,HBHCDFLT,HBHCPARAM) ;
  1.  N HBHCINP,HBHCRETV
  1.  F  D  Q:HBHCINP<0!($L($P(HBHCINP,U,2))>1)
  1.  . S HBHCINP=$$SRCHSTR(HBHCPARAM("SEARCH_PROMPT"),HBHCPARAM("HELP ?"),HBHCPARAM("HELP ??"),HBHCDFLT)
  1.  . 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
  1.  I HBHCINP<0 Q +HBHCINP
  1.  S HBHCRETV=$$LEXICD10($P(HBHCINP,U,2),HBHCDT,.HBHCPARAM)
  1.  I HBHCRETV=-1 Q -8   ;non selection
  1.  I HBHCRETV=-2 Q -6   ;search timed out
  1.  I HBHCRETV=-3 Q -7   ;search was aborted by user by entering "^" or "^^"
  1.  I HBHCRETV=-4 Q -9   ;user answered NO for the question "Do you wish to continue(Y/N)?" when search returned lot of values
  1.  Q HBHCRETV
  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.  ; HBHCDT - date of interest
  1.  ; HBHCDFLT - default values for the search string (can be a code by default)
  1.  ; HBHCPARAM - 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.  ; or -1 Dx entry prompt: if invalid data(press enter)
  1.  ; or -2 Dx entry prompt: if time out
  1.  ; or -3 Dx entry prompt: if ^ or ^^
  1.  ; or -4 Dx entry prompt: if no changes to the default value
  1.  ; or -5 Dx entry prompt: if user enters "@"
  1.  ; or -6 Dx search prompt: if time out
  1.  ; or -7 Dx search prompt: search was aborted by user by entering "^" or "^^"
  1.  ; or -8 Dx search prompt: user selected nothing
  1.  ; or "" Dx search prompt: if not found
  1.  ;
  1. DIAG9(HBHCDT,HBHCDFLT,HBHCPARAM) ;
  1.  N HBHCINP,HBHCRETV
  1.  S HBHCINP=$$SRCHSTR(HBHCPARAM("SEARCH_PROMPT"),HBHCPARAM("HELP ?"),HBHCPARAM("HELP ??"),HBHCDFLT)
  1.  I +HBHCINP<0 Q +HBHCINP
  1.  S HBHCRETV=$$FMICD9($P(HBHCINP,U,2),HBHCDT)
  1.  S HBHCRETV=$P(HBHCRETV,U,1)
  1.  I HBHCRETV=-3 Q -6  ;search timed-out
  1.  I HBHCRETV=-2 Q -7  ;search was aborted by user by entering "^" or "^^"
  1.  I HBHCRETV=-1 Q -8  ;user selected nothing or no values found
  1.  Q HBHCRETV
  1.  ;
  1.  ;---------
  1.  ;The entry point for ICD-10 diagnosis search functionality
  1.  ;input parameters :
  1.  ; HBHCTXT - search string
  1.  ; HBHCDATE - date of interest
  1.  ; HBHCPAR - 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 non selection
  1.  ; -2 if search timed out
  1.  ; -3 if search was aborted by user by entering "^" or "^^"
  1.  ; -4 if user answered NO for the question "Do you wish to continue(Y/N)?" when search returned lot of values
  1.  ;
  1. LEXICD10(HBHCTXT,HBHCDATE,HBHCPAR) ; ICD-10 Search
  1.  N HBHCLVTXT
  1.  ;parameters check
  1.  S HBHCDATE=+$G(HBHCDATE)
  1.  I HBHCDATE'?7N Q -1
  1.  S HBHCTXT=$G(HBHCTXT)
  1.  Q:'$L(HBHCTXT) -1
  1.  N HBHCNUMB
  1.  S HBHCNUMB=$$FREQ^LEXU(HBHCTXT)
  1.  I HBHCNUMB>$$MAX^LEXU(30) D  I $$QUESTION("N",HBHCPARAM("WISH CONTINUE"))'=1 Q -4
  1.  . D FORMWRIT(HBHCPAR("EXCEEDS MESSAGE1")_HBHCTXT_HBHCPAR("EXCEEDS MESSAGE2")_HBHCNUMB_HBHCPAR("EXCEEDS MESSAGE3")_HBHCTXT_""".",0)
  1.  . D FORMWRIT("",2)
  1.  ;new and set variables
  1.  N DIROUT,DUOUT,DTOUT,HBHCEXIT,HBHCICDNT
  1.  N HBHCRETV,HBHCXX,HBHCLEVEL
  1.  S HBHCRETV=""
  1.  S HBHCEXIT=0
  1.  S HBHCLEVEL=1,HBHCLVTXT(HBHCLEVEL)=HBHCTXT ;level 1 stores the original search string
  1.  ; main loop
  1.  F  Q:HBHCEXIT>0  D
  1.  . K HBHCICDY
  1.  . ;get the search string from the current level and call LEX API
  1.  . S HBHCICDY=$$DIAGSRCH^LEX10CS(HBHCLVTXT(HBHCLEVEL),.HBHCICDY,HBHCDATE,30)
  1.  . S:$O(HBHCICDY(" "),-1)>0 HBHCICDY=+HBHCICDY
  1.  . ; Nothing found
  1.  . I +HBHCICDY'>0 S HBHCEXIT=1 S HBHCXX=-1 Q
  1.  . ; display the list of items and ask the user to select the item from the list
  1.  . S HBHCXX=$$SEL^HBHCLKU2(.HBHCICDY,8)
  1.  . ; if ^ was entered 
  1.  . ;   if this is on the top level then quit 
  1.  . I HBHCXX=-2,HBHCLEVEL'>1 S HBHCRETV=-3 S HBHCEXIT=1 Q
  1.  . ;   if lower level then go one level up
  1.  . I HBHCXX=-2,HBHCLEVEL>1 S HBHCLEVEL=HBHCLEVEL-1 Q
  1.  . ; If timeout then quit
  1.  . I HBHCXX=-3 S HBHCRETV=-2 S HBHCEXIT=1 Q
  1.  . ; If not selected then quit
  1.  . I HBHCXX=-1 S HBHCRETV=-1 S HBHCEXIT=1 Q
  1.  . ; If ^^ then quit
  1.  . I HBHCXX=-5 S HBHCRETV=-3 S HBHCEXIT=1 Q
  1.  . ; if Code Found and Selected by the user save selection in HBHCRETV and quit
  1.  . I $P(HBHCXX,";")'="99:CAT" S HBHCRETV=HBHCXX S HBHCEXIT=1 Q
  1.  . ; If Category Found and Selected by the user:  
  1.  . ;  go to the next inner level
  1.  . ;  change level number 
  1.  . S HBHCLEVEL=HBHCLEVEL+1
  1.  . ;  set the new level with the new search string
  1.  . ;  and repeat 
  1.  . S HBHCLVTXT(HBHCLEVEL)=$P($P($G(HBHCXX),"^"),";",2)
  1.  Q HBHCRETV
  1.  ;
  1.  ;---------
  1.  ;ICD-9 lookup (FileMan lookup)
  1.  ;Input parameters :
  1.  ; HBHCSRCH - search string 
  1.  ; HBHCICDT - date of interest  
  1.  ;returns ICD-9 code selected by the user:
  1.  ;  IEN file #80;ICD code value^description
  1.  ; or 
  1.  ; -1 if error like no selection made or search found nothing
  1.  ; -2 if exit : ^ or ^^
  1.  ; -3 if timed out
  1.  ;Note: this API is not silent because the ICD lookup is not silent
  1. FMICD9(HBHCSRCH,HBHCICDT) ;
  1.  N KEY,X,Y,DIC,HBHCCDS
  1.  ;KEY must be newed as ICD lookup code doesn't kill it
  1.  S DIC="^ICD9(",DIC(0)="EQZ"
  1.  ; Set screening of inactive codes!!
  1.  S HBHCCDS="ICD9"
  1.  S DIC("S")="I $$CSI^ICDEX(80,Y)=1"
  1.  ; both X and Y should be set to the search string
  1.  S (X,Y)=HBHCSRCH
  1.  D ^DIC
  1.  I $G(Y) D  Q Y
  1.  . I $P(Y,U,1)<0 D
  1.  . . S:$D(DUOUT) Y=-2  ;search aborted
  1.  . . S:$D(DTOUT) Y=-3  ;timed out
  1.  Q X
  1.  ;
  1.  ;---------
  1.  ; Clean up environment and quit
  1. CLEANUP ;
  1.  K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,%Y,DIWL,DIWR
  1.  Q
  1.  ;
  1.  ;---------
  1.  ;ask YES/NO questions
  1.  ;input parameters :
  1.  ; HBHCDFLT- 0/null- not default, 1- yes, 2 -no
  1.  ; HBHCPROM - prompt string
  1.  ;returns 
  1.  ; 2 - no,
  1.  ; 1 -yes,
  1.  ; 0 - no answer
  1. QUESTION(HBHCDFLT,HBHCPROM) ;
  1.  W:$L($G(HBHCPROM)) !,HBHCPROM
  1.  S %=$G(HBHCDFLT,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.  ; HBHCPRMT prompt text
  1.  ; HBHCHLP1 "?" help text
  1.  ; HBHCHLP2 "??" help text
  1.  ; HBHCDFLT- 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 -4 if user accepts default value
  1.  ; or -5 if user enters "@"
  1.  ; piece2: string entered by the user
  1. SRCHSTR(HBHCPRMT,HBHCHLP1,HBHCHLP2,HBHCDFLT) ;
  1.  N DIR
  1.  S DIR("A")=HBHCPRMT
  1.  S DIR("?")=HBHCHLP1
  1.  S DIR("??")=HBHCHLP2
  1.  I $L($G(HBHCDFLT)) S DIR("B")=HBHCDFLT
  1.  S DIR(0)="FAOr^0:245"
  1.  D ^DIR
  1.  Q:$D(DTOUT) -2
  1.  Q:$D(DUOUT) -3
  1.  Q:X="@" -5
  1.  Q:Y["^" -3
  1.  Q:Y="" -1
  1.  Q:(($L($G(HBHCDFLT)))&(Y=HBHCDFLT)) -4  ;if user accepts default value then no need to validate it
  1.  Q 0_U_Y
  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.  ; HBHCPAR  - local array to sets and store string constants for your messages and prompts 
  1.  ; HBHCMODE - Admission or Discharge entry
  1.  ; HBHCCS   - Search coding system
  1. SETPARAM(HBHCPAR,HBHCMODE,HBHCCS) ;
  1.  I HBHCMODE=1 S HBHCPAR("SEARCH_PROMPT")="PRIMARY DIAGNOSIS @ ADMISSION: " I 1
  1.  E  I HBHCMODE=2 S HBHCPAR("SEARCH_PROMPT")="PRIMARY DIAGNOSIS @ DISCHARGE: " I 1
  1.  E  S HBHCPAR("SEARCH_PROMPT")="Enter Diagnosis, a Code or a Code Fragment: "
  1.  I HBHCCS=1 D  I 1
  1.  . S HBHCPAR("HELP ?")="^D HLPICD9^HBHCLKU1"
  1.  . S HBHCPAR("HELP ??")="^D HLPICD9^HBHCLKU1"
  1.  E  I HBHCCS=30 D  I 1
  1.  . S HBHCPAR("HELP ?")="^D HLPICD10^HBHCLKU1"
  1.  . S HBHCPAR("HELP ??")="^D HLPICD10^HBHCLKU1"
  1.  S HBHCPAR("WISH CONTINUE")="Do you wish to continue(Y/N)"
  1.  S HBHCPAR("EXCEEDS MESSAGE1")="Searching for """
  1.  S HBHCPAR("EXCEEDS MESSAGE2")=""" requires inspecting "
  1.  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 """
  1.  S HBHCPAR("DELETE?")="   SURE YOU WANT TO DELETE"
  1.  S HBHCPAR("ENTER MORE")=" Please enter at least the first two characters of the ICD-10 code or code"
  1.  S HBHCPAR("ENTER MORE2")=" description to start the search."
  1.  Q
  1.  ;
  1.  ;---------
  1.  ; Look-up help for ICD-10
  1. HLPICD10 ;
  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.  ;---------
  1.  ; Look-up help for ICD-9
  1. HLPICD9 ;
  1.  N DIC,D,DIFORMAT,DZ
  1.  I $G(X)["??" D  I 1
  1.  . W "        This field represents patient's primary diagnosis at time of admission,"
  1.  . W !,"        referencing ICD Diagnosis (80) file entries."
  1.  . S DZ="??"
  1.  E  D
  1.  . W "     Answer with ICD diagnosis code, or diagnosis description, of patient's"
  1.  . W !,"     primary diagnosis at time of admission."
  1.  S D="B"
  1.  S DIC="^ICD9(",DIC(0)="IMEQXZ"
  1.  S DIC("S")="I $$CSI^ICDEX(80,Y)=1"
  1.  D DQ^DICQ
  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.  ; HBHCMODE:
  1.  ;  0 - start
  1.  ;  1 - accumulate 
  1.  ;  2 - write
  1.  ;example:
  1.  ;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)
  1.  ;D FORMWRIT^HBHCLKU1("some more text ",1)
  1.  ;D FORMWRIT^HBHCLKU1("",2)
  1. FORMWRIT(X,HBHCMODE) ;
  1.  N HBHCLI1
  1.  ;if "start" mode
  1.  I HBHCMODE=0 K ^UTILITY($J,"W")
  1.  S DIWL=1,DIWR=79
  1.  I $L(X)>0 D ^DIWP
  1.  ;if "write" mode
  1.  I HBHCMODE=2 D
  1.  . S HBHCLI1=0 F  S HBHCLI1=$O(^UTILITY($J,"W",1,HBHCLI1)) Q:+HBHCLI1=0  W !,$G(^UTILITY($J,"W",1,HBHCLI1,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.  ;