TIUU ; SLC/JER - Utility subroutines for Discharge Summary ;9/7/94 16:37
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997;
TITLE(X) ; Pads titles
; Recieves: X=title to be padded
N I,TITLE
S TITLE="" F I=1:1:$L(X) S TITLE=TITLE_" "_$E(X,I)
Q TITLE
JUSTIFY(X,JUST) ; Justifies Text
; Receives: X=text to be justified
; JUST="L" --> left, "C" --> center, "R" --> right,
; "J" --> justified to WIDTH
; WIDTH=justification width (when JUST="j"
I "Cc"[JUST W ?((80-$L(X))/2),X
I "Ll"[JUST W X,!!
I "Rr"[JUST W ?(80-$L(X)),X
Q
STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen
N DIR,X,Y
I $E(IOST)'="C" S Y="" G STOPX
I +$G(SCROLL),(IOSL>($Y+5)) F W ! Q:IOSL<($Y+6)
S DIR(0)="FO^1:1",DIR("A")=$S($G(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit")
S DIR("?")="Enter '^' to quit present action or '^^' to quit to menu"
D ^DIR I $D(DIRUT),(Y="") K DIRUT
S Y=$S(Y="^":0,Y="^^":0,$D(DTOUT):"",Y="":1,1:1_U_Y)
STOPX Q Y
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ; Calls reader, returns response
N DIR,X,Y
S DIR(0)=TYPE
I $D(SCREEN) S DIR("S")=SCREEN
I $G(PROMPT)]"" S DIR("A")=PROMPT
I $G(DEFAULT)]"" S DIR("B")=DEFAULT
I $D(HELP) S DIR("?")=HELP
D ^DIR
I $G(X)="@" S Y="@" G READX
I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)
READX Q Y
UPDATE ; Updates fields in review screen
; Receives: X=new value of field
; FLD=name of field to be modified
I $D(^TMP("TIUVIEW",$J,3,0)),+$G(TIUDA) D
. S ^TMP("TIUVIEW",$J,3,0)=$$SETSTR^VALM1("SIG STATUS: "_$P($$STATUS^TIULC(TIUDA),U,2),$G(^TMP("TIUVIEW",$J,3,0)),38,41)
Q
LISTREAD(TIULIST,ANSTYPE) ; Present list to user for selection of item(s)
N TIUI,TIUL,TIUY S (TIUI,TIUY)=0
S ANSTYPE=$S($G(ANSTYPE)]"":$G(ANSTYPE),1:"N")
F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0 D
. W !,TIUI,?5,$P(TIULIST(TIUI),U,2) S TIUL=TIUI
I +$G(TIUL) D
. W !
. S TIUY=$$READ(ANSTYPE_"A^1:"_TIUL,"Select "_$P(TIULIST,U)_": ")
. I +TIUY S TIUY=$G(TIULIST(+TIUY))
Q TIUY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUU 2028 printed Oct 16, 2024@18:46:56 Page 2
TIUU ; SLC/JER - Utility subroutines for Discharge Summary ;9/7/94 16:37
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997;
TITLE(X) ; Pads titles
+1 ; Recieves: X=title to be padded
+2 NEW I,TITLE
+3 SET TITLE=""
FOR I=1:1:$LENGTH(X)
SET TITLE=TITLE_" "_$EXTRACT(X,I)
+4 QUIT TITLE
JUSTIFY(X,JUST) ; Justifies Text
+1 ; Receives: X=text to be justified
+2 ; JUST="L" --> left, "C" --> center, "R" --> right,
+3 ; "J" --> justified to WIDTH
+4 ; WIDTH=justification width (when JUST="j"
+5 IF "Cc"[JUST
WRITE ?((80-$LENGTH(X))/2),X
+6 IF "Ll"[JUST
WRITE X,!!
+7 IF "Rr"[JUST
WRITE ?(80-$LENGTH(X)),X
+8 QUIT
STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen
+1 NEW DIR,X,Y
+2 IF $EXTRACT(IOST)'="C"
SET Y=""
GOTO STOPX
+3 IF +$GET(SCROLL)
IF (IOSL>($Y+5))
FOR
WRITE !
if IOSL<($Y+6)
QUIT
+4 SET DIR(0)="FO^1:1"
SET DIR("A")=$SELECT($GET(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit")
+5 SET DIR("?")="Enter '^' to quit present action or '^^' to quit to menu"
+6 DO ^DIR
IF $DATA(DIRUT)
IF (Y="")
KILL DIRUT
+7 SET Y=$SELECT(Y="^":0,Y="^^":0,$DATA(DTOUT):"",Y="":1,1:1_U_Y)
STOPX QUIT Y
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ; Calls reader, returns response
+1 NEW DIR,X,Y
+2 SET DIR(0)=TYPE
+3 IF $DATA(SCREEN)
SET DIR("S")=SCREEN
+4 IF $GET(PROMPT)]""
SET DIR("A")=PROMPT
+5 IF $GET(DEFAULT)]""
SET DIR("B")=DEFAULT
+6 IF $DATA(HELP)
SET DIR("?")=HELP
+7 DO ^DIR
+8 IF $GET(X)="@"
SET Y="@"
GOTO READX
+9 IF Y]""
IF ($LENGTH($GET(Y),U)'=2)
SET Y=Y_U_$GET(Y(0),Y)
READX QUIT Y
UPDATE ; Updates fields in review screen
+1 ; Receives: X=new value of field
+2 ; FLD=name of field to be modified
+3 IF $DATA(^TMP("TIUVIEW",$JOB,3,0))
IF +$GET(TIUDA)
Begin DoDot:1
+4 SET ^TMP("TIUVIEW",$JOB,3,0)=$$SETSTR^VALM1("SIG STATUS: "_$PIECE($$STATUS^TIULC(TIUDA),U,2),$GET(^TMP("TIUVIEW",$JOB,3,0)),38,41)
End DoDot:1
+5 QUIT
LISTREAD(TIULIST,ANSTYPE) ; Present list to user for selection of item(s)
+1 NEW TIUI,TIUL,TIUY
SET (TIUI,TIUY)=0
+2 SET ANSTYPE=$SELECT($GET(ANSTYPE)]"":$GET(ANSTYPE),1:"N")
+3 FOR
SET TIUI=$ORDER(TIULIST(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+4 WRITE !,TIUI,?5,$PIECE(TIULIST(TIUI),U,2)
SET TIUL=TIUI
End DoDot:1
+5 IF +$GET(TIUL)
Begin DoDot:1
+6 WRITE !
+7 SET TIUY=$$READ(ANSTYPE_"A^1:"_TIUL,"Select "_$PIECE(TIULIST,U)_": ")
+8 IF +TIUY
SET TIUY=$GET(TIULIST(+TIUY))
End DoDot:1
+9 QUIT TIUY
