source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFL.m@ 724

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
 ;