source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFL.m@ 902

Last change on this file since 902 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1TIUFL ; SLC/MAM - Library of Modules and Functions: SETUP, RMSG, CENTER(X,N) ;02/16/06
2 ;;1.0;TEXT INTEGRATION UTILITIES;**14,184,211**;Jun 20, 1997;Build 26
3 ;
4CENTER(X,N) ; Center X in space of N Characters. Adapted from TIULS.
5 ; Truncates X to N chars if X>N. NOTE: LM truncates header at scroll lock if header longer than VALMWD-1.
6 N SP,ANSCTR
7 S $P(SP," ",((N-$L(X))\2)+1)=""
8 S ANSCTR=$G(SP)_X_$G(SP) I $L(ANSCTR)>N S ANSCTR=$E(ANSCTR,1,N)
9 Q ANSCTR
10 ;
11SETUP ; Sets ^TMP("TIUF",$J) array before entering Document Definition Utility, etc.
12 ; Array is used in routines and in protocols, including protocol
13 ;item text and item displayed name. If Type field Set of Codes changes,
14 ;or allowable Statuses from TIU Status File, then ^TMP("TIUF" array and
15 ;associated protocols will need changing.
16 ; TIUF uses protocols TIUF TYPE etc. and TIUF STATUS etc. so that Type,
17 ;Status, and Sort values can be edited at the bottom of the LM screen
18 ;without allowed choices scrolling off.
19 N DIC,X,Y,TIUFI,DA
20 S TIUFPRIV=1
21 S X="IOELALL" D ENDR^%ZISS
22ARRNO ; ^TMP("TIUF",$J) subscripts ARRNO_H/A/C/J/T/D/O.
23 ; e.g. ^TMP("TIUF",$J,"ARRNOH")= 1 since LM Template H uses Array
24 ;number 1, i.e. ^TMP("TIUF1" Arrays.
25 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
26 ;
27CLINDOC ; subscript "CLINDOC".
28 ; e.g. ^TMP("TIUF",$J,"CLINDOC")=38
29 S DIC=8925.1,DIC(0)="X",X="CLINICAL DOCUMENTS" D ^DIC
30 G:Y=-1 SETUX
31 S ^TMP("TIUF",$J,"CLINDOC")=+Y
32CLPAC ; Subscript "CLPAC" NOTE: may not find it so subscript may not exist
33 S DIC=8930,DIC(0)="X"
34 S X="CLINICAL COORDINATOR" D ^DIC
35 I Y>0 S ^TMP("TIUF",$J,"CLPAC")=+Y
36RM ; Subscripts "RMAC", "RMAM", "RMHC", "RMHM",
37 ;"RMCM", "RMJC", "RMJM", "RMT", "RMD" similar to VALM("RM"),
38 ;LM Template Right Margin for Sub/Templates A, H, C, and J, T, D;
39 ;for TIUFWHO Clinician, Manager.
40 S TIUF("RMAC")=186
41 S TIUF("RMAM")=195
42 S TIUF("RMHC")=179
43 S TIUF("RMHM")=188
44 S TIUF("RMCM")=188
45 S TIUF("RMJC")=157
46 S TIUF("RMJM")=166
47 S TIUF("RMT")=123
48 S (TIUF("RMD"),TIUF("RMXM"),TIUF("RMXC"))=80
49NMWIDTH ; Subscript NMWIDTH for entry name in Temps HACJ.
50 S ^TMP("TIUF",$J,"NMWIDTH")=$S("NM"[TIUFWHO:65,1:72) ; Used in Create options.
51 ;
52HIDDEN ; Subscript HIDDEN for IFN of protocol TIUF HIDDEN ACTIONS
53 S DIC=101
54 S X="TIUF HIDDEN ACTIONS" D ^DIC G:Y=-1 SETUX
55 S ^TMP("TIUF",$J,"HIDDEN")=+Y
56 ;
57STOP ; Subscript STOP for IFN of protocol TIUF QUIT1
58 S DIC=101
59 S X="TIUF QUIT1" D ^DIC G:Y=-1 SETUX
60 S ^TMP("TIUF",$J,"STOP")=+Y
61 ;
62NEWHELP ; Subscript NEWHELP for IFN of protocol TIUFC ACTION MENU
63 S DIC=101
64 S X="TIUFC ACTION MENU" D ^DIC G:Y=-1 SETUX
65 S ^TMP("TIUF",$J,"NEWHELP")=+Y
66 ;
67INHERIT ; Subscript INHERIT for IFN of protocol TIUFD ACTION MENU MGR
68 S DIC=101
69 S X="TIUFD ACTION MENU MGR" D ^DIC G:Y=-1 SETUX
70 S ^TMP("TIUF",$J,"INHERIT")=+Y
71 ;
72RIGHT ; Subscript RIGHT for IFN of protocol TIUF RIGHT.
73 S DIC=101
74 S X="TIUF RIGHT" D ^DIC G:Y=-1 SETUX
75 S ^TMP("TIUF",$J,"RIGHT")=+Y
76 ;
77LEFT ; Subscript LEFT for IFN of protocol TIUF LEFT.
78 S DIC=101
79 S X="TIUF LEFT" D ^DIC G:Y=-1 SETUX
80 S ^TMP("TIUF",$J,"LEFT")=+Y
81 ;
82CREATE ; Subscript CREATE for IFN of protocol TIUFC ACTION MENU.
83 S DIC=101
84 S X="TIUFC ACTION MENU" D ^DIC G:Y=-1 SETUX
85 S ^TMP("TIUF",$J,"CREATE")=+Y
86 ;
87TYPE ; Subscripts TYPECL, TYPEDC, TYPETL, etc.
88 S ^TMP("TIUF",$J,"TYPECL")="CLASS"
89 S ^TMP("TIUF",$J,"TYPEDC")="DOCUMENT CLASS"
90 S ^TMP("TIUF",$J,"TYPETL")="TITLE"
91 S ^TMP("TIUF",$J,"TYPECO")="COMPONENT"
92 S ^TMP("TIUF",$J,"TYPEO")="OBJECT"
93 S ^TMP("TIUF",$J,"TYPENONE")="NONE"
94 ;
95STAT ; subscripts "STATI" (I for Inactive), "STATT" (T for Test),
96 ;"STATA" (A for Active), "PCLSTAT", "STAT#"
97 ; e.g. ^TMP("TIUF",$J,"STATI")=13^INACTIVE where
98 ; 13 = TIU Status File IFN for INACTIVE.
99 ; e.g. ^TMP("TIUF",$J,"STAT13")="INACTIVE" where
100 ; 13 = IFN of INACTIVE in TIU Status File.
101 ;
102 S DIC=8925.6,DIC(0)="X"
103 F TIUFI="INACTIVE","TEST","ACTIVE" D G:Y=-1 SETUX
104 . S X=TIUFI D ^DIC Q:Y=-1
105 . S ^TMP("TIUF",$J,"STAT"_$E(TIUFI))=+Y_U_TIUFI,^TMP("TIUF",$J,"STAT"_+Y)=TIUFI
106 . Q
107SORT ; subscripts "SORT", "SORTCM" (CM for CHANGE SORT MENU),
108 ; e.g. ^TMP("TIUF",$J,"SORT")=3766, =IFN of protocol TIUF SORT
109 ; e.g. ^TMP("TIUF",$J,"SORTCM")=3819, =IFN of protocol TIUF CHANGE SORT MENU
110 ; e.g. ^TMP("TIUF",$J,"SORTT")=3635, =IFN of protocol TIUF SORT BY TYPE
111 K DIC,DA S DIC=101,DIC(0)="X",X="TIUF SORT" D ^DIC G:Y=-1 SETUX
112 S ^TMP("TIUF",$J,"SORT")=+Y
113 S X="TIUF CHANGE SORT MENU" D ^DIC G:Y=-1 SETUX
114 S ^TMP("TIUF",$J,"SORTCM")=+Y
115 F TIUFI="T^TYPE","O^OWNER","S^STATUS","U^USED BY DOCMTS","P^PARENTAGE" D G:Y=-1 SETUX
116 . S X="TIUF SORT BY "_$P(TIUFI,U,2) D ^DIC I Y=-1 Q
117 . S ^TMP("TIUF",$J,"SORT"_$P(TIUFI,U))=+Y
118MSG S ^TMP("TIUF",$J,"SMSG")="?Help >ScrollRight PS/PL PrintScrn/List +/-"
119 S ^TMP("TIUF",$J,"MSG")="? Help +, - Next, Previous Screen PS/PL"
120 S ^TMP("TIUF",$J,"NMSG")="New Users, Please Enter '?NEW' for Help"
121FLDNAM ; Single Subscripts are Field Numbers: e.g. ^TMP("TIUF",$J,4,"LABEL")="Upload Look-Up Method".
122 ;See also FLDTYPE for second piece.
123 S ^TMP("TIUF",$J,0,"LABEL")="IFN^BASICS"
124 S ^TMP("TIUF",$J,1.03,"LABEL")="TARGET TEXT FIELD"
125 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)")
126 ;S ^TMP("TIUF",$J,.05,"LABEL")="OWNER^BASICS"
127 ; Double Subscripts are Field Numbers of Multiples,SubField Numbers: e.g
128 ;^TMP("TIUF",$J,1,.01,"LABEL")="Header Piece", the .01 subfield of Multiple field 1:
129 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)")
130 F TIUFI=2,3,4 D FIELD^DID(8925.14,TIUFI,"","LABEL","^TMP(""TIUF"",$J,10,TIUFI)")
131 ;
132FLDTYPE ; Sets ^ piece after FLDNAME = BASICS, TECH, UPLOAD or UPHEAD, i.e. which part of the display the field is in.
133 F TIUFI=.01:.01:.15,3.02,3.03,1501 S $P(^TMP("TIUF",$J,TIUFI,"LABEL"),U,2)="BASICS"
134 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"
135 F TIUFI=1.01:.01:1.03,4,4.5,4.8 S $P(^TMP("TIUF",$J,TIUFI,"LABEL"),U,2)="UPLOAD"
136 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"
137SETUX I $G(Y)=-1 W !!," Missing Basic Variables; See IRM.",! D PAUSE^TIUFXHLX S VALMQUIT=1
138 Q
139 ;
140RMSG ; redisplays standard TIUF msg. Sets VALMSG=stnd msg. Called by items of LM Protocol Menus, items of TIUF HIDDEN ACTIONS.
141 ; Requires TIUFSTMP if currently in subtemplate;
142 ; Requires TIUF messages as set in TIUFL.
143 N MSG
144 S VALMSG=$$VMSG
145 D MSG^VALM10(MSG)
146 Q
147 ;
148VMSG() ; Function returns standard VALMSG for a Template.
149 N VMSG
150 I $G(TIUFCBEG) S VMSG=^TMP("TIUF",$J,"NMSG") G VMSG1
151 I "HACJ"[TIUFTMPL,'$D(TIUFSTMP) D G VMSG1
152 . I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"RIGHT") S VMSG=^TMP("TIUF",$J,"MSG") Q
153 . I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"LEFT") S VMSG=^TMP("TIUF",$J,"SMSG") Q
154 . I $G(VALMLFT)<80 S VMSG=^TMP("TIUF",$J,"SMSG") Q
155 . S VMSG=^TMP("TIUF",$J,"MSG")
156 I $G(TIUFSTMP)="T" D G VMSG1
157 . I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"RIGHT") S VMSG=^TMP("TIUF",$J,"MSG") Q
158 . I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"LEFT") S VMSG=^TMP("TIUF",$J,"SMSG") Q
159 . I $G(VALMLFT)<80 S VMSG=^TMP("TIUF",$J,"SMSG") Q
160 . S VMSG=^TMP("TIUF",$J,"MSG")
161 I $G(TIUFSTMP)="D"!($G(TIUFSTMP)="X") S VMSG=^TMP("TIUF",$J,"MSG")
162VMSG1 Q VMSG
163 ;
Note: See TracBrowser for help on using the repository browser.