TIUFLLM2 ; SLC/MAM - Library; LM Related: BUFENTRY(INFO,NODE0,CONTENT,PFILEDA), CONTENT params: 80,N,H,B,I,W ;4/28/97 21:21
;;1.0;TEXT INTEGRATION UTILITIES;**6,43**;Jun 20, 1997
;IHS/ITSC/LJF 02/26/2003 - moved status column into view
; modified list template TIUFJ OBJECT MGR for column heading
;
BUFENTRY(INFO,NODE0,CONTENT,PFILEDA) ;Get data for FILEDA; set Docmt
;Def entry INFO("FILEDA") into buffer array, inserting it at lineno
;+INFO with Lineno +INFO.
; This module adds ONE line to buffer array and is called multiple
;times to complete buffer array. When finished, buffer array is
;inserted AS IS into LM array ^TMP("TIUF1/2/or3" for LM Sub/Template
;TIUFTMPL/TIUFSTMP (unless CONTENT contains W, in which case Buffer
;Array is written to screen.)
; Buffer array does NOT necessarily start with line 1, but with line
;0 if CONTENT contains W, or with number appropriate for where it will
;be inserted into LM array.
;
; Requires INFO array, where INFO is either as set in NINFO^TIUFLLM if
;entry is not yet in LM array, or is = ^TMP("TIUF*IDX,$J,LINENO) if
;entry is already in LM array, and where INFO array is as set in
;PARSE^TIUFLLM(INFO). FILEDA = INFO("FILEDA"), is entry in 8925.1.
; Requires Array NODE0, set as TIUFNOD0 in NODE0ARR^TIUFLF. NODE0 is
;enhanced 0 node of FILEDA.
; Requires CONTENT = String of flags defining what information is set
;into buffer array for FILEDA: parameters allowed: 80, H, C, A, J, D, O,
;T, W. For more info on CONTENT see rtn TIUFLLM3.
; Requires PFILEDA if CONTENT contains D, or T, where
;PFILEDA=FILEDA of (anticipated) parent of entry.
; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
; Can't use VALMDDEF since called by nontarget Template.
;
N DIC,DIQ,DA,DR,MNEM,MENUTEXT,SEQUENCE,NUMBER,NAME,TIUREC,IFN
N TYPE,LP,LC,OWNER,TIUREC,STATUS,DDEFUSED,INUSE
N MNWIDTH,RESTCOL,NMCOLUMN,TIUFI,FILEDA,BOILPT,SHARE,POWNER,COWNER,ITEMS
N CONT80,CONTH,CONTC,CONTA,CONTJ,CONTD,CONTT,CONTW,CONTO
N PRINTNM,NATIONAL,FRACTION,BLANKS
; If already had LM array node for entry and saved it (nothing changed except lineno) then put IT in buffer instead of getting all data again:
I $D(TIUFSAVE(INFO("FILEDA"))) D Q
. S TIUREC=TIUFSAVE(INFO("FILEDA")) S BLANKS=$L(+INFO)-$L(+TIUFSAVE(INFO("FILEDA")))
. S TIUREC=+INFO_$S(BLANKS=2:"",BLANKS:" ",1:" ")_$E(TIUREC,$L(+TIUFSAVE(INFO("FILEDA")))+3,500)
. S ^TMP("TIUFB",$J,+INFO,0)=TIUREC
. S ^TMP("TIUFBIDX",$J,+INFO)=INFO
S CONTH=$S(CONTENT["H":1,1:0),CONTC=$S(CONTENT["C":1,1:0),CONTA=$S(CONTENT["A":1,1:0)
S CONTJ=$S(CONTENT["J":1,1:0),CONTD=$S(CONTENT["D":1,1:0),CONTT=$S(CONTENT["T":1,1:0),CONTW=$S(CONTENT["W":1,1:0),CONT80=$S(+CONTENT:1,1:0),CONTO=$S(CONTENT["O":1,1:0)
NUM ; Set Entry number
I CONTH!CONTA!CONTC!CONTJ!CONTT S NUMBER=$S(+INFO:+INFO,1:""),TIUREC=$$SETSTR^VALM1(NUMBER,"",1,5),NMCOLUMN=8
E S TIUREC="",NMCOLUMN=2
NAME ; Set DDEF Name, Type into TIUREC:
S NAME=$P(NODE0,U),TYPE=$P(NODE0,U,4) S:TYPE="DOC" TYPE="TL"
I CONTH!CONTC S NAME=$J(NAME,$L(NAME)+(2*(INFO("LEVEL"))))
;S TIUREC=$$SETSTR^VALM1(NAME,TIUREC,NMCOLUMN,$S(CONTD:37,CONTO:55,1:67)) ;IHS/ITSC/LJF 02/26/2003
S TIUREC=$$SETSTR^VALM1(NAME,TIUREC,NMCOLUMN,$S(CONTD:37,CONTO:55,CONTJ:50,1:67)) ;IHS/ITSC/LJF 02/26/2003 move status column
I CONTH!CONTA!CONTC D
. I TYPE'="",NODE0("SHARE")="Yes" S TYPE=$E(TYPE,1,2)_" S"
. S TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,77,4) Q
;I CONTJ S STATUS=$E(NODE0("STATUS")),STATUS=$J(STATUS,6) S TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,75,6) ;IHS/ITSC/LJF 02/26/2003
I CONTJ S STATUS=$E(NODE0("STATUS")),STATUS=$J(STATUS,6) S TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,65,6) ;IHS/ITSC/LJF 02/26/2003 move status column
;
I $D(PFILEDA),CONTD!CONTT D
. K TIUFQ S DIC=8925.1,DA=PFILEDA,DIQ="TIUFQ",DR="10",DA(8925.14)=INFO("TENDA"),DR(8925.14)=".01:4" D EN^DIQ1
. S MNEM=TIUFQ(8925.14,INFO("TENDA"),2),MNEM=$J(MNEM,4)
. I TYPE'="CL",(TYPE'="DC") S MNEM=" "
. S MENUTEXT=TIUFQ(8925.14,INFO("TENDA"),4),SEQUENCE=TIUFQ(8925.14,INFO("TENDA"),3),FRACTION=$P(SEQUENCE,".",2),SEQUENCE=$S(FRACTION="":SEQUENCE_" ",$L(FRACTION)=1:SEQUENCE_" ",1:SEQUENCE_""),SEQUENCE=$J(SEQUENCE,6)
. K TIUFQ
I CONTT,SEQUENCE'="" S TIUREC=$$SETSTR^VALM1(SEQUENCE,TIUREC,75,6)
;
S FILEDA=INFO("FILEDA")
GET ; Get/Set the rest of the line:
S IFN=FILEDA,IFN=$J(IFN,7)
I CONT80!CONTH!CONTA!CONTC!CONTJ!CONTW D
. S NATIONAL=NODE0("NATL"),NATIONAL=$J(NATIONAL,4)
. S:TIUFTMPL'["J" INUSE=NODE0("INUSE"),INUSE=$J(INUSE,6)
. I TIUFTMPL'["J" S STATUS=$E(NODE0("STATUS")),STATUS=$J(STATUS,6) I $P(NODE0,U,10) S STATUS=" "
. S:TIUFTMPL'["J" BOILPT=NODE0("BOILPT"),BOILPT=$J(BOILPT,4)
. S:TIUFTMPL'["J" ITEMS=NODE0("ITEMS"),ITEMS=$J(ITEMS,5)
. S PRINTNM=$P(NODE0,U,3)
I CONT80!CONTH!CONTA!CONTC!CONTJ!CONTW!CONTO D
. S POWNER=$P(NODE0,U,5),LP=$L(POWNER)
. S COWNER=$P(NODE0,U,6),LC=$L(COWNER)
. I LP D
. . S POWNER=$G(^VA(200,POWNER,0))
. . I POWNER="" S POWNER="ERROR" Q
. . S POWNER=$S($L($P(POWNER,U,2)):$P(POWNER,U,2),1:$E($P(POWNER,U),1,7))
. I LC D
. . S COWNER=$$USRCLASS^USRLFF(COWNER) ; **43**
. . I COWNER="" S COWNER="ERROR" Q
. . S COWNER=$S($L($P(COWNER,U,2)):$P(COWNER,U,2),1:$E($P(COWNER,U),1,7))
. S OWNER=$S(LP&'LC:POWNER,LC&'LP:COWNER,LP&LC:$E(POWNER,1,3)_","_$E(COWNER,1,4),1:"")
SET S RESTCOL=$S(CONT80:45,"NM"[TIUFWHO&CONTD:30,CONTD:41,CONTO:57,"C"[TIUFWHO&CONTT:91,1:82)
I CONT80 D G PLUS
. S TIUREC=$$SETSTR^VALM1(" "_TYPE,TIUREC,RESTCOL-1,5),RESTCOL=RESTCOL+6 ;RESTCOL=RESTCOL+LASTWIDTH +2
. S TIUREC=$$SETSTR^VALM1(" "_IFN,TIUREC,RESTCOL-2,9),RESTCOL=RESTCOL+9
. S TIUREC=$$SETSTR^VALM1(" "_NATIONAL,TIUREC,RESTCOL-2,6),RESTCOL=RESTCOL+6
. S TIUREC=$$SETSTR^VALM1(" "_STATUS,TIUREC,RESTCOL-2,8),RESTCOL=RESTCOL+8
. S TIUREC=$$SETSTR^VALM1(" "_OWNER,TIUREC,RESTCOL-2,9),RESTCOL=RESTCOL+9
I CONTO D
. S STATUS=$E(NODE0("STATUS")),STATUS=$J(STATUS,6) S TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,RESTCOL,6),RESTCOL=RESTCOL+8
. S TIUREC=$$SETSTR^VALM1(OWNER,TIUREC,RESTCOL,7),RESTCOL=RESTCOL+9
I "NM"[TIUFWHO D
. I CONTD S TIUREC=$$SETSTR^VALM1(" ",TIUREC,RESTCOL,2),RESTCOL=RESTCOL+2
. S TIUREC=$$SETSTR^VALM1(IFN,TIUREC,RESTCOL,7),RESTCOL=RESTCOL+9 ;RESTCOL=RESTCOL+LASTWIDTH +2
I CONTH!CONTA!CONTC!CONTJ!CONTW D G PLUS
. S TIUREC=$$SETSTR^VALM1(NATIONAL,TIUREC,RESTCOL,4),RESTCOL=RESTCOL+6
. S:TIUFTMPL'["J" TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,RESTCOL,6),RESTCOL=RESTCOL+8
. S TIUREC=$$SETSTR^VALM1(OWNER,TIUREC,RESTCOL,7),RESTCOL=RESTCOL+9
. S:TIUFTMPL'["J" TIUREC=$$SETSTR^VALM1($G(INUSE),TIUREC,RESTCOL,6),RESTCOL=RESTCOL+8
. S:TIUFTMPL'["J" TIUREC=$$SETSTR^VALM1(BOILPT,TIUREC,RESTCOL,4),RESTCOL=RESTCOL+6
. I CONTA S TIUREC=$$SETSTR^VALM1(ITEMS,TIUREC,RESTCOL,5),RESTCOL=RESTCOL+7
. S TIUREC=$$SETSTR^VALM1(PRINTNM,TIUREC,RESTCOL,60)
I CONTD!CONTT D
. S:CONTD TIUREC=$$SETSTR^VALM1(SEQUENCE,TIUREC,RESTCOL,6),RESTCOL=RESTCOL+8
. S TIUREC=$$SETSTR^VALM1(MNEM,TIUREC,RESTCOL,4),RESTCOL=RESTCOL+6
. S TIUREC=$$SETSTR^VALM1(MENUTEXT,TIUREC,RESTCOL,26)
PLUS I CONTH S TIUREC=$$PLUSUP^TIUFLLM(.INFO,TIUREC)
I 'CONT80,'CONTO,'CONTD,'CONTT D RTSCROLL^TIUFLLM(.TIUREC,TYPE)
S ^TMP("TIUFB",$J,+INFO,0)=TIUREC
I 'CONTW D
. S ^TMP("TIUFBIDX",$J,+INFO)=INFO
BUFEX Q
;
TIUFLLM2 ; SLC/MAM - Library; LM Related: BUFENTRY(INFO,NODE0,CONTENT,PFILEDA), CONTENT params: 80,N,H,B,I,W ;4/28/97 21:21
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**6,43**;Jun 20, 1997
+2 ;IHS/ITSC/LJF 02/26/2003 - moved status column into view
+3 ; modified list template TIUFJ OBJECT MGR for column heading
+4 ;
BUFENTRY(INFO,NODE0,CONTENT,PFILEDA) ;Get data for FILEDA; set Docmt
+1 ;Def entry INFO("FILEDA") into buffer array, inserting it at lineno
+2 ;+INFO with Lineno +INFO.
+3 ; This module adds ONE line to buffer array and is called multiple
+4 ;times to complete buffer array. When finished, buffer array is
+5 ;inserted AS IS into LM array ^TMP("TIUF1/2/or3" for LM Sub/Template
+6 ;TIUFTMPL/TIUFSTMP (unless CONTENT contains W, in which case Buffer
+7 ;Array is written to screen.)
+8 ; Buffer array does NOT necessarily start with line 1, but with line
+9 ;0 if CONTENT contains W, or with number appropriate for where it will
+10 ;be inserted into LM array.
+11 ;
+12 ; Requires INFO array, where INFO is either as set in NINFO^TIUFLLM if
+13 ;entry is not yet in LM array, or is = ^TMP("TIUF*IDX,$J,LINENO) if
+14 ;entry is already in LM array, and where INFO array is as set in
+15 ;PARSE^TIUFLLM(INFO). FILEDA = INFO("FILEDA"), is entry in 8925.1.
+16 ; Requires Array NODE0, set as TIUFNOD0 in NODE0ARR^TIUFLF. NODE0 is
+17 ;enhanced 0 node of FILEDA.
+18 ; Requires CONTENT = String of flags defining what information is set
+19 ;into buffer array for FILEDA: parameters allowed: 80, H, C, A, J, D, O,
+20 ;T, W. For more info on CONTENT see rtn TIUFLLM3.
+21 ; Requires PFILEDA if CONTENT contains D, or T, where
+22 ;PFILEDA=FILEDA of (anticipated) parent of entry.
+23 ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
+24 ; Can't use VALMDDEF since called by nontarget Template.
+25 ;
+26 NEW DIC,DIQ,DA,DR,MNEM,MENUTEXT,SEQUENCE,NUMBER,NAME,TIUREC,IFN
+27 NEW TYPE,LP,LC,OWNER,TIUREC,STATUS,DDEFUSED,INUSE
+28 NEW MNWIDTH,RESTCOL,NMCOLUMN,TIUFI,FILEDA,BOILPT,SHARE,POWNER,COWNER,ITEMS
+29 NEW CONT80,CONTH,CONTC,CONTA,CONTJ,CONTD,CONTT,CONTW,CONTO
+30 NEW PRINTNM,NATIONAL,FRACTION,BLANKS
+31 ; If already had LM array node for entry and saved it (nothing changed except lineno) then put IT in buffer instead of getting all data again:
+32 IF $DATA(TIUFSAVE(INFO("FILEDA")))
Begin DoDot:1
+33 SET TIUREC=TIUFSAVE(INFO("FILEDA"))
SET BLANKS=$LENGTH(+INFO)-$LENGTH(+TIUFSAVE(INFO("FILEDA")))
+34 SET TIUREC=+INFO_$SELECT(BLANKS=2:"",BLANKS:" ",1:" ")_$EXTRACT(TIUREC,$LENGTH(+TIUFSAVE(INFO("FILEDA")))+3,500)
+35 SET ^TMP("TIUFB",$JOB,+INFO,0)=TIUREC
+36 SET ^TMP("TIUFBIDX",$JOB,+INFO)=INFO
End DoDot:1
QUIT
+37 SET CONTH=$SELECT(CONTENT["H":1,1:0)
SET CONTC=$SELECT(CONTENT["C":1,1:0)
SET CONTA=$SELECT(CONTENT["A":1,1:0)
+38 SET CONTJ=$SELECT(CONTENT["J":1,1:0)
SET CONTD=$SELECT(CONTENT["D":1,1:0)
SET CONTT=$SELECT(CONTENT["T":1,1:0)
SET CONTW=$SELECT(CONTENT["W":1,1:0)
SET CONT80=$SELECT(+CONTENT:1,1:0)
SET CONTO=$SELECT(CONTENT["O":1,1:0)
NUM ; Set Entry number
+1 IF CONTH!CONTA!CONTC!CONTJ!CONTT
SET NUMBER=$SELECT(+INFO:+INFO,1:"")
SET TIUREC=$$SETSTR^VALM1(NUMBER,"",1,5)
SET NMCOLUMN=8
+2 IF '$TEST
SET TIUREC=""
SET NMCOLUMN=2
NAME ; Set DDEF Name, Type into TIUREC:
+1 SET NAME=$PIECE(NODE0,U)
SET TYPE=$PIECE(NODE0,U,4)
IF TYPE="DOC"
SET TYPE="TL"
+2 IF CONTH!CONTC
SET NAME=$JUSTIFY(NAME,$LENGTH(NAME)+(2*(INFO("LEVEL"))))
+3 ;S TIUREC=$$SETSTR^VALM1(NAME,TIUREC,NMCOLUMN,$S(CONTD:37,CONTO:55,1:67)) ;IHS/ITSC/LJF 02/26/2003
+4 ;IHS/ITSC/LJF 02/26/2003 move status column
SET TIUREC=$$SETSTR^VALM1(NAME,TIUREC,NMCOLUMN,$SELECT(CONTD:37,CONTO:55,CONTJ:50,1:67))
+5 IF CONTH!CONTA!CONTC
Begin DoDot:1
+6 IF TYPE'=""
IF NODE0("SHARE")="Yes"
SET TYPE=$EXTRACT(TYPE,1,2)_" S"
+7 SET TIUREC=$$SETSTR^VALM1(TYPE,TIUREC,77,4)
QUIT
End DoDot:1
+8 ;I CONTJ S STATUS=$E(NODE0("STATUS")),STATUS=$J(STATUS,6) S TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,75,6) ;IHS/ITSC/LJF 02/26/2003
+9 ;IHS/ITSC/LJF 02/26/2003 move status column
IF CONTJ
SET STATUS=$EXTRACT(NODE0("STATUS"))
SET STATUS=$JUSTIFY(STATUS,6)
SET TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,65,6)
+10 ;
+11 IF $DATA(PFILEDA)
IF CONTD!CONTT
Begin DoDot:1
+12 KILL TIUFQ
SET DIC=8925.1
SET DA=PFILEDA
SET DIQ="TIUFQ"
SET DR="10"
SET DA(8925.14)=INFO("TENDA")
SET DR(8925.14)=".01:4"
DO EN^DIQ1
+13 SET MNEM=TIUFQ(8925.14,INFO("TENDA"),2)
SET MNEM=$JUSTIFY(MNEM,4)
+14 IF TYPE'="CL"
IF (TYPE'="DC")
SET MNEM=" "
+15 SET MENUTEXT=TIUFQ(8925.14,INFO("TENDA"),4)
SET SEQUENCE=TIUFQ(8925.14,INFO("TENDA"),3)
SET FRACTION=$PIECE(SEQUENCE,".",2)
SET SEQUENCE=$SELECT(FRACTION="":SEQUENCE_" ",$LENGTH(FRACTION)=1:SEQUENCE_" ",1:SEQUENCE_"")
SET SEQUENCE=$JUSTIFY(SEQUENCE,6)
+16 KILL TIUFQ
End DoDot:1
+17 IF CONTT
IF SEQUENCE'=""
SET TIUREC=$$SETSTR^VALM1(SEQUENCE,TIUREC,75,6)
+18 ;
+19 SET FILEDA=INFO("FILEDA")
GET ; Get/Set the rest of the line:
+1 SET IFN=FILEDA
SET IFN=$JUSTIFY(IFN,7)
+2 IF CONT80!CONTH!CONTA!CONTC!CONTJ!CONTW
Begin DoDot:1
+3 SET NATIONAL=NODE0("NATL")
SET NATIONAL=$JUSTIFY(NATIONAL,4)
+4 IF TIUFTMPL'["J"
SET INUSE=NODE0("INUSE")
SET INUSE=$JUSTIFY(INUSE,6)
+5 IF TIUFTMPL'["J"
SET STATUS=$EXTRACT(NODE0("STATUS"))
SET STATUS=$JUSTIFY(STATUS,6)
IF $PIECE(NODE0,U,10)
SET STATUS=" "
+6 IF TIUFTMPL'["J"
SET BOILPT=NODE0("BOILPT")
SET BOILPT=$JUSTIFY(BOILPT,4)
+7 IF TIUFTMPL'["J"
SET ITEMS=NODE0("ITEMS")
SET ITEMS=$JUSTIFY(ITEMS,5)
+8 SET PRINTNM=$PIECE(NODE0,U,3)
End DoDot:1
+9 IF CONT80!CONTH!CONTA!CONTC!CONTJ!CONTW!CONTO
Begin DoDot:1
+10 SET POWNER=$PIECE(NODE0,U,5)
SET LP=$LENGTH(POWNER)
+11 SET COWNER=$PIECE(NODE0,U,6)
SET LC=$LENGTH(COWNER)
+12 IF LP
Begin DoDot:2
+13 SET POWNER=$GET(^VA(200,POWNER,0))
+14 IF POWNER=""
SET POWNER="ERROR"
QUIT
+15 SET POWNER=$SELECT($LENGTH($PIECE(POWNER,U,2)):$PIECE(POWNER,U,2),1:$EXTRACT($PIECE(POWNER,U),1,7))
End DoDot:2
+16 IF LC
Begin DoDot:2
+17 ; **43**
SET COWNER=$$USRCLASS^USRLFF(COWNER)
+18 IF COWNER=""
SET COWNER="ERROR"
QUIT
+19 SET COWNER=$SELECT($LENGTH($PIECE(COWNER,U,2)):$PIECE(COWNER,U,2),1:$EXTRACT($PIECE(COWNER,U),1,7))
End DoDot:2
+20 SET OWNER=$SELECT(LP&'LC:POWNER,LC&'LP:COWNER,LP&LC:$EXTRACT(POWNER,1,3)_","_$EXTRACT(COWNER,1,4),1:"")
End DoDot:1
SET SET RESTCOL=$SELECT(CONT80:45,"NM"[TIUFWHO&CONTD:30,CONTD:41,CONTO:57,"C"[TIUFWHO&CONTT:91,1:82)
+1 IF CONT80
Begin DoDot:1
+2 ;RESTCOL=RESTCOL+LASTWIDTH +2
SET TIUREC=$$SETSTR^VALM1(" "_TYPE,TIUREC,RESTCOL-1,5)
SET RESTCOL=RESTCOL+6
+3 SET TIUREC=$$SETSTR^VALM1(" "_IFN,TIUREC,RESTCOL-2,9)
SET RESTCOL=RESTCOL+9
+4 SET TIUREC=$$SETSTR^VALM1(" "_NATIONAL,TIUREC,RESTCOL-2,6)
SET RESTCOL=RESTCOL+6
+5 SET TIUREC=$$SETSTR^VALM1(" "_STATUS,TIUREC,RESTCOL-2,8)
SET RESTCOL=RESTCOL+8
+6 SET TIUREC=$$SETSTR^VALM1(" "_OWNER,TIUREC,RESTCOL-2,9)
SET RESTCOL=RESTCOL+9
End DoDot:1
GOTO PLUS
+7 IF CONTO
Begin DoDot:1
+8 SET STATUS=$EXTRACT(NODE0("STATUS"))
SET STATUS=$JUSTIFY(STATUS,6)
SET TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,RESTCOL,6)
SET RESTCOL=RESTCOL+8
+9 SET TIUREC=$$SETSTR^VALM1(OWNER,TIUREC,RESTCOL,7)
SET RESTCOL=RESTCOL+9
End DoDot:1
+10 IF "NM"[TIUFWHO
Begin DoDot:1
+11 IF CONTD
SET TIUREC=$$SETSTR^VALM1(" ",TIUREC,RESTCOL,2)
SET RESTCOL=RESTCOL+2
+12 ;RESTCOL=RESTCOL+LASTWIDTH +2
SET TIUREC=$$SETSTR^VALM1(IFN,TIUREC,RESTCOL,7)
SET RESTCOL=RESTCOL+9
End DoDot:1
+13 IF CONTH!CONTA!CONTC!CONTJ!CONTW
Begin DoDot:1
+14 SET TIUREC=$$SETSTR^VALM1(NATIONAL,TIUREC,RESTCOL,4)
SET RESTCOL=RESTCOL+6
+15 IF TIUFTMPL'["J"
SET TIUREC=$$SETSTR^VALM1(STATUS,TIUREC,RESTCOL,6)
SET RESTCOL=RESTCOL+8
+16 SET TIUREC=$$SETSTR^VALM1(OWNER,TIUREC,RESTCOL,7)
SET RESTCOL=RESTCOL+9
+17 IF TIUFTMPL'["J"
SET TIUREC=$$SETSTR^VALM1($GET(INUSE),TIUREC,RESTCOL,6)
SET RESTCOL=RESTCOL+8
+18 IF TIUFTMPL'["J"
SET TIUREC=$$SETSTR^VALM1(BOILPT,TIUREC,RESTCOL,4)
SET RESTCOL=RESTCOL+6
+19 IF CONTA
SET TIUREC=$$SETSTR^VALM1(ITEMS,TIUREC,RESTCOL,5)
SET RESTCOL=RESTCOL+7
+20 SET TIUREC=$$SETSTR^VALM1(PRINTNM,TIUREC,RESTCOL,60)
End DoDot:1
GOTO PLUS
+21 IF CONTD!CONTT
Begin DoDot:1
+22 IF CONTD
SET TIUREC=$$SETSTR^VALM1(SEQUENCE,TIUREC,RESTCOL,6)
SET RESTCOL=RESTCOL+8
+23 SET TIUREC=$$SETSTR^VALM1(MNEM,TIUREC,RESTCOL,4)
SET RESTCOL=RESTCOL+6
+24 SET TIUREC=$$SETSTR^VALM1(MENUTEXT,TIUREC,RESTCOL,26)
End DoDot:1
PLUS IF CONTH
SET TIUREC=$$PLUSUP^TIUFLLM(.INFO,TIUREC)
+1 IF 'CONT80
IF 'CONTO
IF 'CONTD
IF 'CONTT
DO RTSCROLL^TIUFLLM(.TIUREC,TYPE)
+2 SET ^TMP("TIUFB",$JOB,+INFO,0)=TIUREC
+3 IF 'CONTW
Begin DoDot:1
+4 SET ^TMP("TIUFBIDX",$JOB,+INFO)=INFO
End DoDot:1
BUFEX QUIT
+1 ;