TIUFL ; SLC/MAM - Library of Modules and Functions: SETUP, RMSG, CENTER(X,N) ;02/16/06
;;1.0;TEXT INTEGRATION UTILITIES;**14,184,211**;Jun 20, 1997;Build 26
;
CENTER(X,N) ; Center X in space of N Characters. Adapted from TIULS.
; Truncates X to N chars if X>N. NOTE: LM truncates header at scroll lock if header longer than VALMWD-1.
N SP,ANSCTR
S $P(SP," ",((N-$L(X))\2)+1)=""
S ANSCTR=$G(SP)_X_$G(SP) I $L(ANSCTR)>N S ANSCTR=$E(ANSCTR,1,N)
Q ANSCTR
;
SETUP ; Sets ^TMP("TIUF",$J) array before entering Document Definition Utility, etc.
; Array is used in routines and in protocols, including protocol
;item text and item displayed name. If Type field Set of Codes changes,
;or allowable Statuses from TIU Status File, then ^TMP("TIUF" array and
;associated protocols will need changing.
; TIUF uses protocols TIUF TYPE etc. and TIUF STATUS etc. so that Type,
;Status, and Sort values can be edited at the bottom of the LM screen
;without allowed choices scrolling off.
N DIC,X,Y,TIUFI,DA
S TIUFPRIV=1
S X="IOELALL" D ENDR^%ZISS
ARRNO ; ^TMP("TIUF",$J) subscripts ARRNO_H/A/C/J/T/D/O.
; e.g. ^TMP("TIUF",$J,"ARRNOH")= 1 since LM Template H uses Array
;number 1, i.e. ^TMP("TIUF1" Arrays.
F TIUFI="H","A","C","J","T","D","O" S ^TMP("TIUF",$J,"ARRNO"_TIUFI)=$S("HACJ"[TIUFI:1,TIUFI="T":2,1:3) ; D, O are 3
;
CLINDOC ; subscript "CLINDOC".
; e.g. ^TMP("TIUF",$J,"CLINDOC")=38
S DIC=8925.1,DIC(0)="X",X="CLINICAL DOCUMENTS" D ^DIC
G:Y=-1 SETUX
S ^TMP("TIUF",$J,"CLINDOC")=+Y
CLPAC ; Subscript "CLPAC" NOTE: may not find it so subscript may not exist
S DIC=8930,DIC(0)="X"
S X="CLINICAL COORDINATOR" D ^DIC
I Y>0 S ^TMP("TIUF",$J,"CLPAC")=+Y
RM ; Subscripts "RMAC", "RMAM", "RMHC", "RMHM",
;"RMCM", "RMJC", "RMJM", "RMT", "RMD" similar to VALM("RM"),
;LM Template Right Margin for Sub/Templates A, H, C, and J, T, D;
;for TIUFWHO Clinician, Manager.
S TIUF("RMAC")=186
S TIUF("RMAM")=195
S TIUF("RMHC")=179
S TIUF("RMHM")=188
S TIUF("RMCM")=188
S TIUF("RMJC")=157
S TIUF("RMJM")=166
S TIUF("RMT")=123
S (TIUF("RMD"),TIUF("RMXM"),TIUF("RMXC"))=80
NMWIDTH ; Subscript NMWIDTH for entry name in Temps HACJ.
S ^TMP("TIUF",$J,"NMWIDTH")=$S("NM"[TIUFWHO:65,1:72) ; Used in Create options.
;
HIDDEN ; Subscript HIDDEN for IFN of protocol TIUF HIDDEN ACTIONS
S DIC=101
S X="TIUF HIDDEN ACTIONS" D ^DIC G:Y=-1 SETUX
S ^TMP("TIUF",$J,"HIDDEN")=+Y
;
STOP ; Subscript STOP for IFN of protocol TIUF QUIT1
S DIC=101
S X="TIUF QUIT1" D ^DIC G:Y=-1 SETUX
S ^TMP("TIUF",$J,"STOP")=+Y
;
NEWHELP ; Subscript NEWHELP for IFN of protocol TIUFC ACTION MENU
S DIC=101
S X="TIUFC ACTION MENU" D ^DIC G:Y=-1 SETUX
S ^TMP("TIUF",$J,"NEWHELP")=+Y
;
INHERIT ; Subscript INHERIT for IFN of protocol TIUFD ACTION MENU MGR
S DIC=101
S X="TIUFD ACTION MENU MGR" D ^DIC G:Y=-1 SETUX
S ^TMP("TIUF",$J,"INHERIT")=+Y
;
RIGHT ; Subscript RIGHT for IFN of protocol TIUF RIGHT.
S DIC=101
S X="TIUF RIGHT" D ^DIC G:Y=-1 SETUX
S ^TMP("TIUF",$J,"RIGHT")=+Y
;
LEFT ; Subscript LEFT for IFN of protocol TIUF LEFT.
S DIC=101
S X="TIUF LEFT" D ^DIC G:Y=-1 SETUX
S ^TMP("TIUF",$J,"LEFT")=+Y
;
CREATE ; Subscript CREATE for IFN of protocol TIUFC ACTION MENU.
S DIC=101
S X="TIUFC ACTION MENU" D ^DIC G:Y=-1 SETUX
S ^TMP("TIUF",$J,"CREATE")=+Y
;
TYPE ; Subscripts TYPECL, TYPEDC, TYPETL, etc.
S ^TMP("TIUF",$J,"TYPECL")="CLASS"
S ^TMP("TIUF",$J,"TYPEDC")="DOCUMENT CLASS"
S ^TMP("TIUF",$J,"TYPETL")="TITLE"
S ^TMP("TIUF",$J,"TYPECO")="COMPONENT"
S ^TMP("TIUF",$J,"TYPEO")="OBJECT"
S ^TMP("TIUF",$J,"TYPENONE")="NONE"
;
STAT ; subscripts "STATI" (I for Inactive), "STATT" (T for Test),
;"STATA" (A for Active), "PCLSTAT", "STAT#"
; e.g. ^TMP("TIUF",$J,"STATI")=13^INACTIVE where
; 13 = TIU Status File IFN for INACTIVE.
; e.g. ^TMP("TIUF",$J,"STAT13")="INACTIVE" where
; 13 = IFN of INACTIVE in TIU Status File.
;
S DIC=8925.6,DIC(0)="X"
F TIUFI="INACTIVE","TEST","ACTIVE" D G:Y=-1 SETUX
. S X=TIUFI D ^DIC Q:Y=-1
. S ^TMP("TIUF",$J,"STAT"_$E(TIUFI))=+Y_U_TIUFI,^TMP("TIUF",$J,"STAT"_+Y)=TIUFI
. Q
SORT ; subscripts "SORT", "SORTCM" (CM for CHANGE SORT MENU),
; e.g. ^TMP("TIUF",$J,"SORT")=3766, =IFN of protocol TIUF SORT
; e.g. ^TMP("TIUF",$J,"SORTCM")=3819, =IFN of protocol TIUF CHANGE SORT MENU
; e.g. ^TMP("TIUF",$J,"SORTT")=3635, =IFN of protocol TIUF SORT BY TYPE
K DIC,DA S DIC=101,DIC(0)="X",X="TIUF SORT" D ^DIC G:Y=-1 SETUX
S ^TMP("TIUF",$J,"SORT")=+Y
S X="TIUF CHANGE SORT MENU" D ^DIC G:Y=-1 SETUX
S ^TMP("TIUF",$J,"SORTCM")=+Y
F TIUFI="T^TYPE","O^OWNER","S^STATUS","U^USED BY DOCMTS","P^PARENTAGE" D G:Y=-1 SETUX
. S X="TIUF SORT BY "_$P(TIUFI,U,2) D ^DIC I Y=-1 Q
. S ^TMP("TIUF",$J,"SORT"_$P(TIUFI,U))=+Y
MSG S ^TMP("TIUF",$J,"SMSG")="?Help >ScrollRight PS/PL PrintScrn/List +/-"
S ^TMP("TIUF",$J,"MSG")="? Help +, - Next, Previous Screen PS/PL"
S ^TMP("TIUF",$J,"NMSG")="New Users, Please Enter '?NEW' for Help"
FLDNAM ; Single Subscripts are Field Numbers: e.g. ^TMP("TIUF",$J,4,"LABEL")="Upload Look-Up Method".
;See also FLDTYPE for second piece.
S ^TMP("TIUF",$J,0,"LABEL")="IFN^BASICS"
S ^TMP("TIUF",$J,1.03,"LABEL")="TARGET TEXT FIELD"
F TIUFI=.01:.01:.15,1.01,1.02,2,3,3.02,3.03,4,4.1,4.2,4.3,4.4,4.45,4.5,4.6,4.7,4.8,4.9,5,6,6.1,6.12,6.13,6.14,7,8,9,10,1501 D FIELD^DID(8925.1,TIUFI,"","LABEL","^TMP(""TIUF"",$J,TIUFI)")
;S ^TMP("TIUF",$J,.05,"LABEL")="OWNER^BASICS"
; Double Subscripts are Field Numbers of Multiples,SubField Numbers: e.g
;^TMP("TIUF",$J,1,.01,"LABEL")="Header Piece", the .01 subfield of Multiple field 1:
F TIUFI=.01:.01:.07,1 D FIELD^DID(8925.11,TIUFI,"","LABEL","^TMP(""TIUF"",$J,1,TIUFI)"),FIELD^DID(8925.12,TIUFI,"","LABEL","^TMP(""TIUF"",$J,2,TIUFI)")
F TIUFI=2,3,4 D FIELD^DID(8925.14,TIUFI,"","LABEL","^TMP(""TIUF"",$J,10,TIUFI)")
;
FLDTYPE ; Sets ^ piece after FLDNAME = BASICS, TECH, UPLOAD or UPHEAD, i.e. which part of the display the field is in.
F TIUFI=.01:.01:.15,3.02,3.03,1501 S $P(^TMP("TIUF",$J,TIUFI,"LABEL"),U,2)="BASICS"
F TIUFI=4.1,4.2,4.3,4.4,4.45,4.6,4.7,4.9,5,6,6.1,6.12,6.13,6.14,7,8,9 S $P(^TMP("TIUF",$J,TIUFI,"LABEL"),U,2)="TECH"
F TIUFI=1.01:.01:1.03,4,4.5,4.8 S $P(^TMP("TIUF",$J,TIUFI,"LABEL"),U,2)="UPLOAD"
F TIUFI=.01:.01:.07,1,2 S $P(^TMP("TIUF",$J,1,TIUFI,"LABEL"),U,2)="UPHEAD",$P(^TMP("TIUF",$J,2,TIUFI,"LABEL"),U,2)="UPHEAD"
SETUX I $G(Y)=-1 W !!," Missing Basic Variables; See IRM.",! D PAUSE^TIUFXHLX S VALMQUIT=1
Q
;
RMSG ; redisplays standard TIUF msg. Sets VALMSG=stnd msg. Called by items of LM Protocol Menus, items of TIUF HIDDEN ACTIONS.
; Requires TIUFSTMP if currently in subtemplate;
; Requires TIUF messages as set in TIUFL.
N MSG
S VALMSG=$$VMSG
D MSG^VALM10(MSG)
Q
;
VMSG() ; Function returns standard VALMSG for a Template.
N VMSG
I $G(TIUFCBEG) S VMSG=^TMP("TIUF",$J,"NMSG") G VMSG1
I "HACJ"[TIUFTMPL,'$D(TIUFSTMP) D G VMSG1
. I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"RIGHT") S VMSG=^TMP("TIUF",$J,"MSG") Q
. I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"LEFT") S VMSG=^TMP("TIUF",$J,"SMSG") Q
. I $G(VALMLFT)<80 S VMSG=^TMP("TIUF",$J,"SMSG") Q
. S VMSG=^TMP("TIUF",$J,"MSG")
I $G(TIUFSTMP)="T" D G VMSG1
. I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"RIGHT") S VMSG=^TMP("TIUF",$J,"MSG") Q
. I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"LEFT") S VMSG=^TMP("TIUF",$J,"SMSG") Q
. I $G(VALMLFT)<80 S VMSG=^TMP("TIUF",$J,"SMSG") Q
. S VMSG=^TMP("TIUF",$J,"MSG")
I $G(TIUFSTMP)="D"!($G(TIUFSTMP)="X") S VMSG=^TMP("TIUF",$J,"MSG")
VMSG1 Q VMSG
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFL 7596 printed Apr 09, 2024@21:46:42 Page 2
TIUFL ; SLC/MAM - Library of Modules and Functions: SETUP, RMSG, CENTER(X,N) ;02/16/06
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**14,184,211**;Jun 20, 1997;Build 26
+2 ;
CENTER(X,N) ; Center X in space of N Characters. Adapted from TIULS.
+1 ; Truncates X to N chars if X>N. NOTE: LM truncates header at scroll lock if header longer than VALMWD-1.
+2 NEW SP,ANSCTR
+3 SET $PIECE(SP," ",((N-$LENGTH(X))\2)+1)=""
+4 SET ANSCTR=$GET(SP)_X_$GET(SP)
IF $LENGTH(ANSCTR)>N
SET ANSCTR=$EXTRACT(ANSCTR,1,N)
+5 QUIT ANSCTR
+6 ;
SETUP ; Sets ^TMP("TIUF",$J) array before entering Document Definition Utility, etc.
+1 ; Array is used in routines and in protocols, including protocol
+2 ;item text and item displayed name. If Type field Set of Codes changes,
+3 ;or allowable Statuses from TIU Status File, then ^TMP("TIUF" array and
+4 ;associated protocols will need changing.
+5 ; TIUF uses protocols TIUF TYPE etc. and TIUF STATUS etc. so that Type,
+6 ;Status, and Sort values can be edited at the bottom of the LM screen
+7 ;without allowed choices scrolling off.
+8 NEW DIC,X,Y,TIUFI,DA
+9 SET TIUFPRIV=1
+10 SET X="IOELALL"
DO ENDR^%ZISS
ARRNO ; ^TMP("TIUF",$J) subscripts ARRNO_H/A/C/J/T/D/O.
+1 ; e.g. ^TMP("TIUF",$J,"ARRNOH")= 1 since LM Template H uses Array
+2 ;number 1, i.e. ^TMP("TIUF1" Arrays.
+3 ; D, O are 3
FOR TIUFI="H","A","C","J","T","D","O"
SET ^TMP("TIUF",$JOB,"ARRNO"_TIUFI)=$SELECT("HACJ"[TIUFI:1,TIUFI="T":2,1:3)
+4 ;
CLINDOC ; subscript "CLINDOC".
+1 ; e.g. ^TMP("TIUF",$J,"CLINDOC")=38
+2 SET DIC=8925.1
SET DIC(0)="X"
SET X="CLINICAL DOCUMENTS"
DO ^DIC
+3 if Y=-1
GOTO SETUX
+4 SET ^TMP("TIUF",$JOB,"CLINDOC")=+Y
CLPAC ; Subscript "CLPAC" NOTE: may not find it so subscript may not exist
+1 SET DIC=8930
SET DIC(0)="X"
+2 SET X="CLINICAL COORDINATOR"
DO ^DIC
+3 IF Y>0
SET ^TMP("TIUF",$JOB,"CLPAC")=+Y
RM ; Subscripts "RMAC", "RMAM", "RMHC", "RMHM",
+1 ;"RMCM", "RMJC", "RMJM", "RMT", "RMD" similar to VALM("RM"),
+2 ;LM Template Right Margin for Sub/Templates A, H, C, and J, T, D;
+3 ;for TIUFWHO Clinician, Manager.
+4 SET TIUF("RMAC")=186
+5 SET TIUF("RMAM")=195
+6 SET TIUF("RMHC")=179
+7 SET TIUF("RMHM")=188
+8 SET TIUF("RMCM")=188
+9 SET TIUF("RMJC")=157
+10 SET TIUF("RMJM")=166
+11 SET TIUF("RMT")=123
+12 SET (TIUF("RMD"),TIUF("RMXM"),TIUF("RMXC"))=80
NMWIDTH ; Subscript NMWIDTH for entry name in Temps HACJ.
+1 ; Used in Create options.
SET ^TMP("TIUF",$JOB,"NMWIDTH")=$SELECT("NM"[TIUFWHO:65,1:72)
+2 ;
HIDDEN ; Subscript HIDDEN for IFN of protocol TIUF HIDDEN ACTIONS
+1 SET DIC=101
+2 SET X="TIUF HIDDEN ACTIONS"
DO ^DIC
if Y=-1
GOTO SETUX
+3 SET ^TMP("TIUF",$JOB,"HIDDEN")=+Y
+4 ;
STOP ; Subscript STOP for IFN of protocol TIUF QUIT1
+1 SET DIC=101
+2 SET X="TIUF QUIT1"
DO ^DIC
if Y=-1
GOTO SETUX
+3 SET ^TMP("TIUF",$JOB,"STOP")=+Y
+4 ;
NEWHELP ; Subscript NEWHELP for IFN of protocol TIUFC ACTION MENU
+1 SET DIC=101
+2 SET X="TIUFC ACTION MENU"
DO ^DIC
if Y=-1
GOTO SETUX
+3 SET ^TMP("TIUF",$JOB,"NEWHELP")=+Y
+4 ;
INHERIT ; Subscript INHERIT for IFN of protocol TIUFD ACTION MENU MGR
+1 SET DIC=101
+2 SET X="TIUFD ACTION MENU MGR"
DO ^DIC
if Y=-1
GOTO SETUX
+3 SET ^TMP("TIUF",$JOB,"INHERIT")=+Y
+4 ;
RIGHT ; Subscript RIGHT for IFN of protocol TIUF RIGHT.
+1 SET DIC=101
+2 SET X="TIUF RIGHT"
DO ^DIC
if Y=-1
GOTO SETUX
+3 SET ^TMP("TIUF",$JOB,"RIGHT")=+Y
+4 ;
LEFT ; Subscript LEFT for IFN of protocol TIUF LEFT.
+1 SET DIC=101
+2 SET X="TIUF LEFT"
DO ^DIC
if Y=-1
GOTO SETUX
+3 SET ^TMP("TIUF",$JOB,"LEFT")=+Y
+4 ;
CREATE ; Subscript CREATE for IFN of protocol TIUFC ACTION MENU.
+1 SET DIC=101
+2 SET X="TIUFC ACTION MENU"
DO ^DIC
if Y=-1
GOTO SETUX
+3 SET ^TMP("TIUF",$JOB,"CREATE")=+Y
+4 ;
TYPE ; Subscripts TYPECL, TYPEDC, TYPETL, etc.
+1 SET ^TMP("TIUF",$JOB,"TYPECL")="CLASS"
+2 SET ^TMP("TIUF",$JOB,"TYPEDC")="DOCUMENT CLASS"
+3 SET ^TMP("TIUF",$JOB,"TYPETL")="TITLE"
+4 SET ^TMP("TIUF",$JOB,"TYPECO")="COMPONENT"
+5 SET ^TMP("TIUF",$JOB,"TYPEO")="OBJECT"
+6 SET ^TMP("TIUF",$JOB,"TYPENONE")="NONE"
+7 ;
STAT ; subscripts "STATI" (I for Inactive), "STATT" (T for Test),
+1 ;"STATA" (A for Active), "PCLSTAT", "STAT#"
+2 ; e.g. ^TMP("TIUF",$J,"STATI")=13^INACTIVE where
+3 ; 13 = TIU Status File IFN for INACTIVE.
+4 ; e.g. ^TMP("TIUF",$J,"STAT13")="INACTIVE" where
+5 ; 13 = IFN of INACTIVE in TIU Status File.
+6 ;
+7 SET DIC=8925.6
SET DIC(0)="X"
+8 FOR TIUFI="INACTIVE","TEST","ACTIVE"
Begin DoDot:1
+9 SET X=TIUFI
DO ^DIC
if Y=-1
QUIT
+10 SET ^TMP("TIUF",$JOB,"STAT"_$EXTRACT(TIUFI))=+Y_U_TIUFI
SET ^TMP("TIUF",$JOB,"STAT"_+Y)=TIUFI
+11 QUIT
End DoDot:1
if Y=-1
GOTO SETUX
SORT ; subscripts "SORT", "SORTCM" (CM for CHANGE SORT MENU),
+1 ; e.g. ^TMP("TIUF",$J,"SORT")=3766, =IFN of protocol TIUF SORT
+2 ; e.g. ^TMP("TIUF",$J,"SORTCM")=3819, =IFN of protocol TIUF CHANGE SORT MENU
+3 ; e.g. ^TMP("TIUF",$J,"SORTT")=3635, =IFN of protocol TIUF SORT BY TYPE
+4 KILL DIC,DA
SET DIC=101
SET DIC(0)="X"
SET X="TIUF SORT"
DO ^DIC
if Y=-1
GOTO SETUX
+5 SET ^TMP("TIUF",$JOB,"SORT")=+Y
+6 SET X="TIUF CHANGE SORT MENU"
DO ^DIC
if Y=-1
GOTO SETUX
+7 SET ^TMP("TIUF",$JOB,"SORTCM")=+Y
+8 FOR TIUFI="T^TYPE","O^OWNER","S^STATUS","U^USED BY DOCMTS","P^PARENTAGE"
Begin DoDot:1
+9 SET X="TIUF SORT BY "_$PIECE(TIUFI,U,2)
DO ^DIC
IF Y=-1
QUIT
+10 SET ^TMP("TIUF",$JOB,"SORT"_$PIECE(TIUFI,U))=+Y
End DoDot:1
if Y=-1
GOTO SETUX
MSG SET ^TMP("TIUF",$JOB,"SMSG")="?Help >ScrollRight PS/PL PrintScrn/List +/-"
+1 SET ^TMP("TIUF",$JOB,"MSG")="? Help +, - Next, Previous Screen PS/PL"
+2 SET ^TMP("TIUF",$JOB,"NMSG")="New Users, Please Enter '?NEW' for Help"
FLDNAM ; Single Subscripts are Field Numbers: e.g. ^TMP("TIUF",$J,4,"LABEL")="Upload Look-Up Method".
+1 ;See also FLDTYPE for second piece.
+2 SET ^TMP("TIUF",$JOB,0,"LABEL")="IFN^BASICS"
+3 SET ^TMP("TIUF",$JOB,1.03,"LABEL")="TARGET TEXT FIELD"
+4 FOR TIUFI=.01:.01:.15,1.01,1.02,2,3,3.02,3.03,4,4.1,4.2,4.3,4.4,4.45,4.5,4.6,4.7,4.8,4.9,5,6,6.1,6.12,6.13,6.14,7,8,9,10,1501
DO FIELD^DID(8925.1,TIUFI,"","LABEL","^TMP(""TIUF"",$J,TIUFI)")
+5 ;S ^TMP("TIUF",$J,.05,"LABEL")="OWNER^BASICS"
+6 ; Double Subscripts are Field Numbers of Multiples,SubField Numbers: e.g
+7 ;^TMP("TIUF",$J,1,.01,"LABEL")="Header Piece", the .01 subfield of Multiple field 1:
+8 FOR TIUFI=.01:.01:.07,1
DO FIELD^DID(8925.11,TIUFI,"","LABEL","^TMP(""TIUF"",$J,1,TIUFI)")
DO FIELD^DID(8925.12,TIUFI,"","LABEL","^TMP(""TIUF"",$J,2,TIUFI)")
+9 FOR TIUFI=2,3,4
DO FIELD^DID(8925.14,TIUFI,"","LABEL","^TMP(""TIUF"",$J,10,TIUFI)")
+10 ;
FLDTYPE ; Sets ^ piece after FLDNAME = BASICS, TECH, UPLOAD or UPHEAD, i.e. which part of the display the field is in.
+1 FOR TIUFI=.01:.01:.15,3.02,3.03,1501
SET $PIECE(^TMP("TIUF",$JOB,TIUFI,"LABEL"),U,2)="BASICS"
+2 FOR TIUFI=4.1,4.2,4.3,4.4,4.45,4.6,4.7,4.9,5,6,6.1,6.12,6.13,6.14,7,8,9
SET $PIECE(^TMP("TIUF",$JOB,TIUFI,"LABEL"),U,2)="TECH"
+3 FOR TIUFI=1.01:.01:1.03,4,4.5,4.8
SET $PIECE(^TMP("TIUF",$JOB,TIUFI,"LABEL"),U,2)="UPLOAD"
+4 FOR TIUFI=.01:.01:.07,1,2
SET $PIECE(^TMP("TIUF",$JOB,1,TIUFI,"LABEL"),U,2)="UPHEAD"
SET $PIECE(^TMP("TIUF",$JOB,2,TIUFI,"LABEL"),U,2)="UPHEAD"
SETUX IF $GET(Y)=-1
WRITE !!," Missing Basic Variables; See IRM.",!
DO PAUSE^TIUFXHLX
SET VALMQUIT=1
+1 QUIT
+2 ;
RMSG ; redisplays standard TIUF msg. Sets VALMSG=stnd msg. Called by items of LM Protocol Menus, items of TIUF HIDDEN ACTIONS.
+1 ; Requires TIUFSTMP if currently in subtemplate;
+2 ; Requires TIUF messages as set in TIUFL.
+3 NEW MSG
+4 SET VALMSG=$$VMSG
+5 DO MSG^VALM10(MSG)
+6 QUIT
+7 ;
VMSG() ; Function returns standard VALMSG for a Template.
+1 NEW VMSG
+2 IF $GET(TIUFCBEG)
SET VMSG=^TMP("TIUF",$JOB,"NMSG")
GOTO VMSG1
+3 IF "HACJ"[TIUFTMPL
IF '$DATA(TIUFSTMP)
Begin DoDot:1
+4 IF $PIECE($GET(XQORNOD),";")=^TMP("TIUF",$JOB,"RIGHT")
SET VMSG=^TMP("TIUF",$JOB,"MSG")
QUIT
+5 IF $PIECE($GET(XQORNOD),";")=^TMP("TIUF",$JOB,"LEFT")
SET VMSG=^TMP("TIUF",$JOB,"SMSG")
QUIT
+6 IF $GET(VALMLFT)<80
SET VMSG=^TMP("TIUF",$JOB,"SMSG")
QUIT
+7 SET VMSG=^TMP("TIUF",$JOB,"MSG")
End DoDot:1
GOTO VMSG1
+8 IF $GET(TIUFSTMP)="T"
Begin DoDot:1
+9 IF $PIECE($GET(XQORNOD),";")=^TMP("TIUF",$JOB,"RIGHT")
SET VMSG=^TMP("TIUF",$JOB,"MSG")
QUIT
+10 IF $PIECE($GET(XQORNOD),";")=^TMP("TIUF",$JOB,"LEFT")
SET VMSG=^TMP("TIUF",$JOB,"SMSG")
QUIT
+11 IF $GET(VALMLFT)<80
SET VMSG=^TMP("TIUF",$JOB,"SMSG")
QUIT
+12 SET VMSG=^TMP("TIUF",$JOB,"MSG")
End DoDot:1
GOTO VMSG1
+13 IF $GET(TIUFSTMP)="D"!($GET(TIUFSTMP)="X")
SET VMSG=^TMP("TIUF",$JOB,"MSG")
VMSG1 QUIT VMSG
+1 ;
