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

TIUCHLP.m

Go to the documentation of this file. 
  1. TIUCHLP ; SLC/SBW - Help for Clinician ;11/29/02
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**3,21,109,148,156**;Jun 20, 1997
  1.  ;IHS/ITSC/LJF  02/26/2003
  1.  ; -- used IHS code for demographic display
  1.  ; -- added screen to select only titles the user can select
  1.  ; -- added dictation data examples to display
  1.  ; -- changed question to be clearer to upload clerks
  1.  ;IHS/ITSC/LJF 06/12/2003 - added quit if patient not selected
  1.  ;
  1. MAIN ; Control branching
  1.  N DIC,X,Y,TIUI,TIUROOT,TIUFPRIV S TIUFPRIV=1
  1.  I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
  1.  S DIC=8925.1,DIC(0)="AEMQZ",DIC("A")="Select DOCUMENT TYPE: "
  1.  S DIC("B")=$G(^DISV(+DUZ,"^TIU(8925.1,"))
  1.  K DIC("B") S DIC("S")="I $P(^(0),U,4)=""DOC"",$$CANPICK^TIULP(+Y)"    ;IHS/ITSC/LJF 02/26/2003 show only titles
  1.  D ^DIC I +Y'>0 D
  1.  . W !!,"Required information for dictation help not set up for this report type."
  1.  I +Y>0 D
  1.  . I $P(TIUPRM0,U,16)="D" S TIUROOT="ITEM"
  1.  . E  I $P(TIUPRM0,U,16)="C" S TIUROOT="HEAD"
  1.  . I $G(TIUROOT)']"" W !!,"Required information for dictation help not set up for this report type." Q
  1.  . W !!,"A Dictated ",$P(Y(0),U),", requires the following:"
  1.  . S TIUI=0
  1.  . F  S TIUI=$O(^TIU(8925.1,+Y,TIUROOT,TIUI)) Q:+TIUI'>0  D
  1.  . . ;I +$P($G(^TIU(8925.1,+Y,TIUROOT,TIUI,0)),U,6) W !?10,$P($G(^(0)),U,2)                     ;IHS/ITSC/LJF 02/26/2003
  1.  . . I +$P($G(^TIU(8925.1,+Y,TIUROOT,TIUI,0)),U,6) W !?5,$P($G(^(0)),U,2),?35,$P($G(^(0)),U,5)  ;IHS/ITSC/LJF 02/26/2003 show examples
  1.  W !!
  1.  I $$READ^TIUU("YO","Do you want to get patient data","YES") D GETPAT
  1.  Q
  1. GETPAT ; Gets Dictation data for a specific patient
  1.  N TIU,TIUOUT,DFN,SUCCESS,TITLE
  1.  F  D  Q:$D(DUOUT)!$D(DIROUT)!+$G(TIUOUT)
  1.  . K TIU                     ;IHS/ITSC/LJF 02/26/2003 clean up before each patient is selected
  1.  . S DFN=+$$PATIENT^TIULA
  1.  . I DFN<1 S TIUOUT=1 Q      ;IHS/ITSC/LJF 6/12/2003 quit if patient not selected
  1.  . D MAIN^TIUMOVE(.TIU,DFN)
  1.  . I $D(TIU) D PATDATA(.TIU)
  1.  . ;S TIUOUT=$$READ^TIUU("Y","... OK","YES")                ;IHS/ITSC/LJF 02/26/2003
  1.  . S Y=$$READ^TIUU("YO","Is this the CORRECT Visit","NO")   ;IHS/ITSC/LJF 02/26/2003  make question clear for upload alerts
  1.  D MAKE^TIUPEFIX(.SUCCESS,DFN,.TITLE,.TIU,$S(+$G(XQADATA):+$G(XQADATA),+$G(BUFDA):+$G(BUFDA),1:""))
  1.  I +SUCCESS S TIUDONE=1
  1.  Q
  1. PATDATA(X) ; Display/validate correct patient/treatment episode
  1.  N DIR,Y,TIURC
  1.  ;W !!?1,"Patient: ",$$NAME^TIULS(X("PNM"),"LAST, FIRST MI"),?40,"SSN: ",X("SSN"),?62,"Sex: ",$P(X("SEX"),U,2),!   ;IHS/ITSC/LJF 02/26/2003
  1.  W !!?1,"Patient: ",$$NAME^TIULS(X("PNM"),"LAST, FIRST MI"),?40,"HRCN: ",X("HRCN"),?62,"Sex: ",$P(X("SEX"),U,2),!  ;IHS/ITSC/LJF 02/26/2003 HRCN for SSN
  1.  W ?4,"Ward: ",$P(X("WARD"),U,2),?40,"Age: ",X("AGE"),!
  1.  W "Att Phys: ",$P(X("AMD"),U,2),?34,"Prim Phys: ",$P(X("PMD"),U,2),!
  1.  W "Adm Date: ",$$DATE^TIULS(+X("EDT"),"MM/DD/YY@HR:MIN:SEC")
  1.  W:X("LDT")]"" ?35,"Dis Date: ",$$DATE^TIULS(X("LDT"),"MM/DD/YY")
  1.  W !
  1.  W ?2,"Adm Dx: ",X("ADDX")
  1.  ; Below TIU*148
  1.  ;IHS/ITSC/LJF 08/20/2003 race is optional and not multiple in IHS
  1.  ;I $G(X("NUMRACE"))>0 D
  1.  ;. W !?4,"Race: " F TIURC=1:1:X("NUMRACE") W ?10,$P(X("RACE",TIURC),U,2),!
  1.  ;I $G(X("RACENO"))=0 W !?4,"Race: ",$P($G(X("RACE")),U,2),!
  1.  I $D(X("DICTDT")) D
  1.  . W !,"A DISCHARGE SUMMARY is already on file:",!
  1.  . W ?2,"Dict'd: ",X("DICTDT"),?41,"By: ",X("AUTHOR"),!
  1.  . W ?2,"Signed: ",X("SIGDT"),?35,"Cosigned: ",X("COSDT"),!
  1.  Q
  1. GETPN ; Help get Fields for PN Dictation/Error Resolution
  1.  N TIU,DFN,TIUY,TITLE
  1.  S DFN=+$$PATIENT^TIULA Q:+DFN'>0
  1.  D ENPN^TIUVSIT(.TIU,+DFN,1)
  1.  I '$D(TIU) Q
  1.  S TIUY=$$CHEKPN(.TIU)
  1.  I 'TIUY Q         ;IHS/ITSC/LJF 02/26/2003 quit if nothing found
  1.  D MAKE^TIUPEFIX(.SUCCESS,DFN,.TITLE,.TIU,$S(+$G(XQADATA):+$G(XQADATA),+$G(BUFDA):+$G(BUFDA),1:""))
  1.  I +SUCCESS S TIUDONE=1
  1.  Q
  1. CHEKPN(X,TIUBY) ; Display/validate demographic/visit information
  1.  ;
  1.  D CHEKPN^BTIUCHLP(.X) G IHS1      ;IHS/ITSC/LJF 02/26/2003 use IHS demographics
  1.  ;
  1.  W !!,"Document Identifiers..."
  1.  W !?14,"Patient Name:  ",$S($G(X("PNM"))]"":$G(X("PNM")),1:"UNKNOWN")
  1.  W !?15,"Patient SSN:  ",$S($G(X("SSN"))]"":$G(X("SSN")),1:"UNKNOWN")
  1.  W !?10,"Patient Location:  ",$S(+$G(X("LOC")):$P($G(X("LOC")),U,2),1:"UNKNOWN")
  1.  W !?8,"Date/time of Visit:  ",$S($L($G(X("VSTR"))):$$DATE^TIULS($P(X("VSTR"),";",2),"MM/DD/YY HR:MIN"),1:"UNKNOWN")
  1.  ;
  1. IHS1 ;IHS/ITSC/LJF 02/26/2003 line label added
  1.  ;S Y=$$READ^TIUU("YO","   ...OK","YES")                           ;IHS/ITSC/LJF 02/26/2003
  1.  S Y=$$READ^TIUU("YO","Okay to Link this VISIT to Document","NO")  ;IHS/ITSC/LJF 02/26/2003 make question clear for upload alerts
  1.  I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) Q 0
  1.  ;
  1.  ;
  1.  I +Y'>0 D
  1.  . K X N TIUINOUT
  1.  . S TIUINOUT=$$INOUT^TIUVSIT
  1.  . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) Q
  1.  . I $P(TIUINOUT,U)="o" D MAIN^TIUVSIT(.X,DFN,"","","","",1,"",20,1)
  1.  . I $P(TIUINOUT,U)'="o" D MAIN^TIUMOVE(.X,DFN,"","","",1,"LAST",1)
  1.  . S Y=$S($D(X)>9:$$CHEKPN(.X,.TIUBY),1:0)
  1.  Q Y