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

PXDSLK.m

Go to the documentation of this file.
  1. PXDSLK ;ALB/RBD - COPIED FROM ICDLOOK TO LOOK UP ICD-10 DX CODE;01 May 2014 1:39 PM
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**199**;Aug 12, 1996;Build 51
  1. ;;
  1. ;
  1. ; Reference to CODEC^ICDEX supported by ICR #5747
  1. ; Reference to CODEN^ICDEX supported by ICR #5747
  1. ; Reference to ^DISV supported by ICR #510
  1. ;
  1. ; PXDATE is the EFFECTIVE DATE that is passed from the Calling Routine
  1. ; PXAGAIN controls the "Try Another" prompt; 0 = do not prompt
  1. ; PXDEF may be passed in as the default Dx value to be prompted
  1. ; PXDXASK if present will be used as the prompt when asking for the Dx code
  1. ;
  1. EN ; Initialize variables
  1. D HOME^%ZIS S DT=$$DT^XLFDT D LOOK
  1. G EXIT
  1. LOOK ; Look-up term
  1. S PXXX=-1 D ASK K DIC
  1. AGAIN ; Try again?
  1. Q:$G(PXAGAIN)=0
  1. W !,"Try another" S %=$S(+($$X):1,1:2)
  1. D YN^DICN I %=-1!(%=2) Q
  1. I '% W !!,"You have searched for an ICD-10 diagnosis code, do you want to" G AGAIN
  1. I +($$X)&(%=1) K PXDEF G LOOK
  1. I '+($$X)&(%=1) G LOOK
  1. I (+($$X)&(%=2))!('+($$X)&(%=1)) Q
  1. G LOOK Q
  1. ASK ; Get user input
  1. N ARY,DIR,DIRUT,DIROUT,PXSYS,PXO,PXY,RES,Y
  1. K %DT,II,PXDT,PXMAX,PXNUMB,PXY
  1. I $G(PXDATE)'="" S Y=PXDATE
  1. I $G(PXDATE)="" K %DT S %DT="AEX",%DT("A")="Date of Interest? " D ^%DT K %DT I Y<0 G EXIT
  1. S PXDT=Y,PXSYS=$P($P($$ACTDT^PXDXUTL(PXDT),U,3),"-",1,2)
  1. K DIR
  1. S DIR("A")=$S($D(PXDXASK):PXDXASK,1:PXSYS_" Diagnosis Code: ")
  1. S DIR("?")="^D INPHLP^PXDSLK",DIR("??")="^D INPHLP^PXDSLK"
  1. I $G(PXDEF)'="",'$D(PXDXASK) S X=PXDEF G ASK2 ; K PXDEF G ASK2
  1. I $G(PXDEF)'="" S DIR("B")=PXDEF
  1. S DIR(0)="FAO^0:60" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
  1. I $L(X)=1,X'=" " D MIN2^PXDSLK G ASK
  1. I X="@" S PXXX="@" Q
  1. ASK2 I PXSYS["10" S PXTXT=X D ICD10 I $G(PXXX)=-2 S PXXX=-1,PXDEF="" G ASK
  1. I PXSYS["-9" W !!,"SORRY, ICD-9 SPECIAL LOOK-UP NOT IMPLEMENTED." Q
  1. I +$G(PXNUMB)>+$G(PXMAX) G ASK
  1. I +PXXX>0 D
  1. . N PXICDIEN S PXICDIEN=$$CODEN^ICDEX($P($P(PXXX,U,1),";",2))
  1. . I +PXICDIEN'=-1 D SAVSPACE("^ICD9(",+PXICDIEN)
  1. ;
  1. Q:$G(X)="" I $G(PXXX)=-1 S PXDEF="" G ASK
  1. Q
  1. ICD10 ; ICD-10 Search
  1. N DIROUT,DUOUT,DTOUT,PXEXIT S PXEXIT=0
  1. ; Begin Recursive Loop
  1. S PXTXT=$G(PXTXT) Q:'$L(PXTXT)
  1. I PXTXT=" " S PXTXT=$$SPACEBAR("^ICD9(") I PXTXT=" " S PXXX=-2 Q
  1. S PXNUMB=$$FREQ^LEXU(PXTXT),PXMAX=$$MAX^LEXU(30)
  1. I PXNUMB>PXMAX D Q:%'=1
  1. . W !!,"Searching for '",PXTXT,"' requires inspecting ",PXNUMB," records to determine"
  1. . W !,"if they match the search criteria. This could take quite some time."
  1. . W !,"Please refine the search by including more detail than '",PXTXT,"'.",!
  1. . K PXDEF
  1. . W !,"Do you wish to continue (Y/N)" S %=2 D YN^DICN W !
  1. S PXDT=$P($G(PXDT),".",1) S:PXDT'?7N PXDT=$$DT^XLFDT
  1. K PXNUMB,PXMAX D LK1
  1. Q
  1. LK1 ; Lookup
  1. Q:+($G(PXEXIT))>0 K PXY
  1. S PXY=$$DIAGSRCH^LEX10CS(PXTXT,.PXY,PXDT,30)
  1. S:$O(PXY(" "),-1)>0 PXY=+PXY
  1. ; Nothing found
  1. I +PXY'>0 W !!,"No records found matching the value entered, revise search or enter ""?"" for",!,"help.",! S PXXX=-2 Q
  1. S PXXX=$$SEL^PXSELDS(.PXY,8),X=PXXX
  1. I PXXX="@" S PXAGAIN=0 Q
  1. I $D(DUOUT)&('$D(DIROUT)) W:'$D(PXNT) !!," Exiting list",! Q
  1. I $D(DTOUT)&('$D(DIROUT)) W !!," Try again later",! S PXXX=-1,PXEXIT=1 Q
  1. I $D(DIROUT) W !!," Exiting list",! S PXXX=-1,PXEXIT=1 Q
  1. ; Abort if timed out or user enters "^^"
  1. I $D(DTOUT)!($D(DIROUT)) S PXEXIT=1 Q
  1. ; Quit if already at top level and user enters "^"
  1. I $D(DUOUT),'$D(DIROUT) Q
  1. ; No Selection
  1. I '$D(DUOUT),PXXX=-1 S PXEXIT=1,PXXX=-2 W !!," No data selected",!
  1. ; Code Found and Selected
  1. I $P(PXXX,";")'="99:CAT" D WRT S PXEXIT=1 Q
  1. ; Category Found and Selected
  1. D NXT G:+($G(PXEXIT))'>0 LK1
  1. Q
  1. WRT ; Write Output
  1. I +PXXX'=-1,PXXX'=-2 D
  1. . N PXCODE,PXTXT,PXI S PXCODE=$P($P(PXXX,"^"),";",2),PXTXT(1)=$P(PXXX,"^",2)
  1. . D PR^PXSELDS(.PXTXT,48) W !
  1. . W !," ICD-10 Diagnosis code: ",?31,PXCODE
  1. . W !," ICD-10 Diagnosis description:",?31,PXTXT(1)
  1. . S PXI=1 F S PXI=$O(PXTXT(PXI)) Q:+PXI'>0 W !,?31,$G(PXTXT(PXI))
  1. . S PXEXIT=1
  1. Q
  1. NXT ; Next
  1. Q:+($G(PXEXIT))>0 N PXNT,PXND,PXX
  1. S PXNT=$G(PXTXT),PXND=$G(PXDT),PXX=$G(PXXX)
  1. N PXTXT,PXDT S PXTXT=$P($P(PXX,"^"),";",2),PXDT=PXND
  1. G LK1
  1. Q
  1. ; retrieves the last code selected by the user - space bar recall
  1. ; logic here
  1. SPACEBAR(PXROOT) ;
  1. N PXICDIEN,PXRTV
  1. S PXRTV=" " I PXROOT="^ICD9(" D
  1. . S PXICDIEN=$G(^DISV(DUZ,PXROOT)) ; PCE subscribes to ICR #510
  1. . I $L(PXICDIEN) S PXRTV=$$CODEC^ICDEX(80,PXICDIEN)
  1. I PXRTV=" " W " ??"
  1. Q PXRTV
  1. ;
  1. ; store the selected code for the space bar recall feature above
  1. SAVSPACE(PXROOT,PXRETV) ;
  1. I +$G(DUZ)=0 Q
  1. I +$G(PXRETV)=0 Q
  1. ; PCE subscribes to ICR #510 for call to RECALL API below
  1. I PXROOT="^ICD9(" D RECALL^DILFD(80,PXRETV_",",+DUZ) Q
  1. Q
  1. ;
  1. INPHLP ; Help text controller for ICD-10
  1. N PXPAUSE S PXPAUSE=0
  1. I X["???" D QM3 Q
  1. I X["??" D QM2 Q
  1. I X["?" D QM1 Q
  1. Q
  1. ;
  1. QM ; Diagnosis help text
  1. ; if calling from outside, set PXPAUSE=1 to pause the display and force the user to press <Enter> to continue
  1. QM1 ; simple help text for 1 question mark
  1. W !,"Enter code or ""text"" for more information.",!
  1. I $G(PXPAUSE) N CR R !,"Press <Enter> to continue: ",CR:DTIME
  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. I $G(PXPAUSE) N CR R !,"Press <Enter> to continue: ",CR:DTIME
  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. I $G(PXPAUSE) N CR R !,"Press <Enter> to continue: ",CR:DTIME
  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. EXIT ; Clean up environment and quit
  1. K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LEX,PXAGAIN,PXDEF,PXDXASK
  1. Q
  1. X(LEX) ; Evaluate X
  1. Q:$L($G(X)) 1 Q 0
  1. Y(LEX) ; Evaluate Y
  1. Q:+($G(Y))>1 1 Q 0