- 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 Jan 18, 2025@03:42:07 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 ;