TIUU.m

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

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