Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUFL

TIUFL.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. 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.
  1. N SP,ANSCTR
  1. S $P(SP," ",((N-$L(X))\2)+1)=""
  1. S ANSCTR=$G(SP)_X_$G(SP) I $L(ANSCTR)>N S ANSCTR=$E(ANSCTR,1,N)
  1. Q ANSCTR
  1. ;
  1. SETUP ; Sets ^TMP("TIUF",$J) array before entering Document Definition Utility, etc.
  1. ; Array is used in routines and in protocols, including protocol
  1. ;item text and item displayed name. If Type field Set of Codes changes,
  1. ;or allowable Statuses from TIU Status File, then ^TMP("TIUF" array and
  1. ;associated protocols will need changing.
  1. ; TIUF uses protocols TIUF TYPE etc. and TIUF STATUS etc. so that Type,
  1. ;Status, and Sort values can be edited at the bottom of the LM screen
  1. ;without allowed choices scrolling off.
  1. N DIC,X,Y,TIUFI,DA
  1. S TIUFPRIV=1
  1. S X="IOELALL" D ENDR^%ZISS
  1. 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
  1. ;number 1, i.e. ^TMP("TIUF1" Arrays.
  1. 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
  1. ;
  1. CLINDOC ; subscript "CLINDOC".
  1. ; e.g. ^TMP("TIUF",$J,"CLINDOC")=38
  1. S DIC=8925.1,DIC(0)="X",X="CLINICAL DOCUMENTS" D ^DIC
  1. G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"CLINDOC")=+Y
  1. CLPAC ; Subscript "CLPAC" NOTE: may not find it so subscript may not exist
  1. S DIC=8930,DIC(0)="X"
  1. S X="CLINICAL COORDINATOR" D ^DIC
  1. I Y>0 S ^TMP("TIUF",$J,"CLPAC")=+Y
  1. RM ; Subscripts "RMAC", "RMAM", "RMHC", "RMHM",
  1. ;"RMCM", "RMJC", "RMJM", "RMT", "RMD" similar to VALM("RM"),
  1. ;LM Template Right Margin for Sub/Templates A, H, C, and J, T, D;
  1. ;for TIUFWHO Clinician, Manager.
  1. S TIUF("RMAC")=186
  1. S TIUF("RMAM")=195
  1. S TIUF("RMHC")=179
  1. S TIUF("RMHM")=188
  1. S TIUF("RMCM")=188
  1. S TIUF("RMJC")=157
  1. S TIUF("RMJM")=166
  1. S TIUF("RMT")=123
  1. S (TIUF("RMD"),TIUF("RMXM"),TIUF("RMXC"))=80
  1. NMWIDTH ; Subscript NMWIDTH for entry name in Temps HACJ.
  1. S ^TMP("TIUF",$J,"NMWIDTH")=$S("NM"[TIUFWHO:65,1:72) ; Used in Create options.
  1. ;
  1. HIDDEN ; Subscript HIDDEN for IFN of protocol TIUF HIDDEN ACTIONS
  1. S DIC=101
  1. S X="TIUF HIDDEN ACTIONS" D ^DIC G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"HIDDEN")=+Y
  1. ;
  1. STOP ; Subscript STOP for IFN of protocol TIUF QUIT1
  1. S DIC=101
  1. S X="TIUF QUIT1" D ^DIC G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"STOP")=+Y
  1. ;
  1. NEWHELP ; Subscript NEWHELP for IFN of protocol TIUFC ACTION MENU
  1. S DIC=101
  1. S X="TIUFC ACTION MENU" D ^DIC G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"NEWHELP")=+Y
  1. ;
  1. INHERIT ; Subscript INHERIT for IFN of protocol TIUFD ACTION MENU MGR
  1. S DIC=101
  1. S X="TIUFD ACTION MENU MGR" D ^DIC G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"INHERIT")=+Y
  1. ;
  1. S DIC=101
  1. S X="TIUF RIGHT" D ^DIC G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"RIGHT")=+Y
  1. ;
  1. LEFT ; Subscript LEFT for IFN of protocol TIUF LEFT.
  1. S DIC=101
  1. S X="TIUF LEFT" D ^DIC G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"LEFT")=+Y
  1. ;
  1. CREATE ; Subscript CREATE for IFN of protocol TIUFC ACTION MENU.
  1. S DIC=101
  1. S X="TIUFC ACTION MENU" D ^DIC G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"CREATE")=+Y
  1. ;
  1. TYPE ; Subscripts TYPECL, TYPEDC, TYPETL, etc.
  1. S ^TMP("TIUF",$J,"TYPECL")="CLASS"
  1. S ^TMP("TIUF",$J,"TYPEDC")="DOCUMENT CLASS"
  1. S ^TMP("TIUF",$J,"TYPETL")="TITLE"
  1. S ^TMP("TIUF",$J,"TYPECO")="COMPONENT"
  1. S ^TMP("TIUF",$J,"TYPEO")="OBJECT"
  1. S ^TMP("TIUF",$J,"TYPENONE")="NONE"
  1. ;
  1. STAT ; subscripts "STATI" (I for Inactive), "STATT" (T for Test),
  1. ;"STATA" (A for Active), "PCLSTAT", "STAT#"
  1. ; e.g. ^TMP("TIUF",$J,"STATI")=13^INACTIVE where
  1. ; 13 = TIU Status File IFN for INACTIVE.
  1. ; e.g. ^TMP("TIUF",$J,"STAT13")="INACTIVE" where
  1. ; 13 = IFN of INACTIVE in TIU Status File.
  1. ;
  1. S DIC=8925.6,DIC(0)="X"
  1. F TIUFI="INACTIVE","TEST","ACTIVE" D G:Y=-1 SETUX
  1. . S X=TIUFI D ^DIC Q:Y=-1
  1. . S ^TMP("TIUF",$J,"STAT"_$E(TIUFI))=+Y_U_TIUFI,^TMP("TIUF",$J,"STAT"_+Y)=TIUFI
  1. . Q
  1. SORT ; subscripts "SORT", "SORTCM" (CM for CHANGE SORT MENU),
  1. ; e.g. ^TMP("TIUF",$J,"SORT")=3766, =IFN of protocol TIUF SORT
  1. ; e.g. ^TMP("TIUF",$J,"SORTCM")=3819, =IFN of protocol TIUF CHANGE SORT MENU
  1. ; e.g. ^TMP("TIUF",$J,"SORTT")=3635, =IFN of protocol TIUF SORT BY TYPE
  1. K DIC,DA S DIC=101,DIC(0)="X",X="TIUF SORT" D ^DIC G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"SORT")=+Y
  1. S X="TIUF CHANGE SORT MENU" D ^DIC G:Y=-1 SETUX
  1. S ^TMP("TIUF",$J,"SORTCM")=+Y
  1. F TIUFI="T^TYPE","O^OWNER","S^STATUS","U^USED BY DOCMTS","P^PARENTAGE" D G:Y=-1 SETUX
  1. . S X="TIUF SORT BY "_$P(TIUFI,U,2) D ^DIC I Y=-1 Q
  1. . S ^TMP("TIUF",$J,"SORT"_$P(TIUFI,U))=+Y
  1. MSG S ^TMP("TIUF",$J,"SMSG")="?Help >ScrollRight PS/PL PrintScrn/List +/-"
  1. S ^TMP("TIUF",$J,"MSG")="? Help +, - Next, Previous Screen PS/PL"
  1. S ^TMP("TIUF",$J,"NMSG")="New Users, Please Enter '?NEW' for Help"
  1. FLDNAM ; Single Subscripts are Field Numbers: e.g. ^TMP("TIUF",$J,4,"LABEL")="Upload Look-Up Method".
  1. ;See also FLDTYPE for second piece.
  1. S ^TMP("TIUF",$J,0,"LABEL")="IFN^BASICS"
  1. S ^TMP("TIUF",$J,1.03,"LABEL")="TARGET TEXT FIELD"
  1. 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)")
  1. ;S ^TMP("TIUF",$J,.05,"LABEL")="OWNER^BASICS"
  1. ; Double Subscripts are Field Numbers of Multiples,SubField Numbers: e.g
  1. ;^TMP("TIUF",$J,1,.01,"LABEL")="Header Piece", the .01 subfield of Multiple field 1:
  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)")
  1. F TIUFI=2,3,4 D FIELD^DID(8925.14,TIUFI,"","LABEL","^TMP(""TIUF"",$J,10,TIUFI)")
  1. ;
  1. FLDTYPE ; Sets ^ piece after FLDNAME = BASICS, TECH, UPLOAD or UPHEAD, i.e. which part of the display the field is in.
  1. F TIUFI=.01:.01:.15,3.02,3.03,1501 S $P(^TMP("TIUF",$J,TIUFI,"LABEL"),U,2)="BASICS"
  1. 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"
  1. F TIUFI=1.01:.01:1.03,4,4.5,4.8 S $P(^TMP("TIUF",$J,TIUFI,"LABEL"),U,2)="UPLOAD"
  1. 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"
  1. SETUX I $G(Y)=-1 W !!," Missing Basic Variables; See IRM.",! D PAUSE^TIUFXHLX S VALMQUIT=1
  1. Q
  1. ;
  1. 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;
  1. ; Requires TIUF messages as set in TIUFL.
  1. N MSG
  1. S VALMSG=$$VMSG
  1. D MSG^VALM10(MSG)
  1. Q
  1. ;
  1. VMSG() ; Function returns standard VALMSG for a Template.
  1. N VMSG
  1. I $G(TIUFCBEG) S VMSG=^TMP("TIUF",$J,"NMSG") G VMSG1
  1. I "HACJ"[TIUFTMPL,'$D(TIUFSTMP) D G VMSG1
  1. . I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"RIGHT") S VMSG=^TMP("TIUF",$J,"MSG") Q
  1. . I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"LEFT") S VMSG=^TMP("TIUF",$J,"SMSG") Q
  1. . I $G(VALMLFT)<80 S VMSG=^TMP("TIUF",$J,"SMSG") Q
  1. . S VMSG=^TMP("TIUF",$J,"MSG")
  1. I $G(TIUFSTMP)="T" D G VMSG1
  1. . I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"RIGHT") S VMSG=^TMP("TIUF",$J,"MSG") Q
  1. . I $P($G(XQORNOD),";")=^TMP("TIUF",$J,"LEFT") S VMSG=^TMP("TIUF",$J,"SMSG") Q
  1. . I $G(VALMLFT)<80 S VMSG=^TMP("TIUF",$J,"SMSG") Q
  1. . S VMSG=^TMP("TIUF",$J,"MSG")
  1. I $G(TIUFSTMP)="D"!($G(TIUFSTMP)="X") S VMSG=^TMP("TIUF",$J,"MSG")
  1. VMSG1 Q VMSG
  1. ;