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

TIUU.m

Go to the documentation of this file.
  1. TIUU ; SLC/JER - Utility subroutines for Discharge Summary ;9/7/94 16:37
  1. ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997;
  1. TITLE(X) ; Pads titles
  1. ; Recieves: X=title to be padded
  1. N I,TITLE
  1. S TITLE="" F I=1:1:$L(X) S TITLE=TITLE_" "_$E(X,I)
  1. Q TITLE
  1. JUSTIFY(X,JUST) ; Justifies Text
  1. ; Receives: X=text to be justified
  1. ; JUST="L" --> left, "C" --> center, "R" --> right,
  1. ; "J" --> justified to WIDTH
  1. ; WIDTH=justification width (when JUST="j"
  1. I "Cc"[JUST W ?((80-$L(X))/2),X
  1. I "Ll"[JUST W X,!!
  1. I "Rr"[JUST W ?(80-$L(X)),X
  1. Q
  1. STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen
  1. N DIR,X,Y
  1. I $E(IOST)'="C" S Y="" G STOPX
  1. I +$G(SCROLL),(IOSL>($Y+5)) F W ! Q:IOSL<($Y+6)
  1. S DIR(0)="FO^1:1",DIR("A")=$S($G(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit")
  1. S DIR("?")="Enter '^' to quit present action or '^^' to quit to menu"
  1. D ^DIR I $D(DIRUT),(Y="") K DIRUT
  1. S Y=$S(Y="^":0,Y="^^":0,$D(DTOUT):"",Y="":1,1:1_U_Y)
  1. STOPX Q Y
  1. READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ; Calls reader, returns response
  1. N DIR,X,Y
  1. S DIR(0)=TYPE
  1. I $D(SCREEN) S DIR("S")=SCREEN
  1. I $G(PROMPT)]"" S DIR("A")=PROMPT
  1. I $G(DEFAULT)]"" S DIR("B")=DEFAULT
  1. I $D(HELP) S DIR("?")=HELP
  1. D ^DIR
  1. I $G(X)="@" S Y="@" G READX
  1. I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)
  1. READX Q Y
  1. UPDATE ; Updates fields in review screen
  1. ; Receives: X=new value of field
  1. ; FLD=name of field to be modified
  1. I $D(^TMP("TIUVIEW",$J,3,0)),+$G(TIUDA) D
  1. . S ^TMP("TIUVIEW",$J,3,0)=$$SETSTR^VALM1("SIG STATUS: "_$P($$STATUS^TIULC(TIUDA),U,2),$G(^TMP("TIUVIEW",$J,3,0)),38,41)
  1. Q
  1. LISTREAD(TIULIST,ANSTYPE) ; Present list to user for selection of item(s)
  1. N TIUI,TIUL,TIUY S (TIUI,TIUY)=0
  1. S ANSTYPE=$S($G(ANSTYPE)]"":$G(ANSTYPE),1:"N")
  1. F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0 D
  1. . W !,TIUI,?5,$P(TIULIST(TIUI),U,2) S TIUL=TIUI
  1. I +$G(TIUL) D
  1. . W !
  1. . S TIUY=$$READ(ANSTYPE_"A^1:"_TIUL,"Select "_$P(TIULIST,U)_": ")
  1. . I +TIUY S TIUY=$G(TIULIST(+TIUY))
  1. Q TIUY