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

TIUSRVT2.m

Go to the documentation of this file.
  1. TIUSRVT2 ; SLC/JM - Server functions for templates ;3/10/2011
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**80,105,249,252**;Jun 20, 1997;Build 6
  1. TACCESS(TIUY,ROOT,USER,LOC) ;Returns Template Access level of User
  1. ;
  1. ;Return Values:
  1. ;
  1. ; 0 = FULL ACCESS
  1. ; 1 = READ ONLY
  1. ; 2 = NO ACCESS
  1. ; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
  1. ;
  1. I +ROOT D Q:+TIUY
  1. .D ISEDITOR^TIUSRVT(.TIUY,ROOT,USER)
  1. .I +TIUY S TIUY=3
  1. .E S TIUY=0
  1. S TIUY=$$GET^XPAR(USER_";VA(200,","TIU PERSONAL TEMPLATE ACCESS",1,"I") ;ICR 2263
  1. I TIUY="" D
  1. .N TIUCLLST,TIUERR,IDX,TMP
  1. .D GETLST^XPAR(.TIUCLLST,"SYS","TIU TEMPLATE ACCESS BY CLASS","Q",.TIUERR) ;ICR 2263
  1. .I TIUERR>0 Q
  1. .S IDX=0
  1. .F S IDX=$O(TIUCLLST(IDX)) Q:'IDX D
  1. ..I $$ISA^USRLM(USER,$P(TIUCLLST(IDX),U),.TIUERR) D ;ICR 1544
  1. ...S TMP=+$P(TIUCLLST(IDX),U,2)
  1. ...I +TIUY'>TMP S TIUY=TMP
  1. I TIUY="" D
  1. .N XPARSRCH,SERVICE
  1. .I +$G(LOC) S XPARSRCH=LOC_";SC("_U
  1. .E S XPARSRCH=""
  1. .;S SERVICE=$P($G(^VA(200,USER,5)),U)
  1. .S SERVICE=$$GETSRV(USER)
  1. .I +SERVICE>0 S XPARSRCH=XPARSRCH_SERVICE_";DIC(49,"_U
  1. .S XPARSRCH=XPARSRCH_"DIV^SYS"
  1. .S TIUY=$$GET^XPAR(XPARSRCH,"TIU PERSONAL TEMPLATE ACCESS")
  1. I TIUY="" S TIUY=0
  1. Q
  1. ;
  1. GETDFLT(TIUY) ;Returns Default Templates for the current user
  1. N TIUTMP,TIUERR
  1. D GETLST^XPAR(.TIUTMP,"USR","TIU DEFAULT TEMPLATES","Q",.TIUERR) ;2263
  1. S TIUY=$P($G(TIUTMP(1)),U,2)
  1. Q
  1. SETDFLT(TIUY,SETTINGS) ;Saves Default Templates for the user
  1. N TIUERR
  1. D EN^XPAR(DUZ_";VA(200,","TIU DEFAULT TEMPLATES",1,SETTINGS,.TIUERR) ;2263
  1. S TIUY=1
  1. Q
  1. LSTACCUM(TIUY,TIULVL,TYP,PARAM) ; Accumulates TIUTMP into TIUY
  1. N IDX,I,J,FOUND,TIUERR,TIUTMP
  1. D GETLST^XPAR(.TIUTMP,TIULVL,PARAM,TYP,.TIUERR)
  1. S I=0,IDX=$O(TIUY(999999),-1)+1
  1. F S I=$O(TIUTMP(I)) Q:'I D
  1. .S (FOUND,J)=0
  1. .F S J=$O(TIUY(J)) Q:'J D Q:FOUND
  1. ..I TIUY(J)=TIUTMP(I) S FOUND=1
  1. .I 'FOUND D
  1. ..S TIUY(IDX)=TIUTMP(I)
  1. ..S IDX=IDX+1
  1. Q
  1. RDACCUM(TIUY,TIULVL,TYP) ; Accumulates Reminder Dialog List
  1. D LSTACCUM(.TIUY,TIULVL,TYP,"TIU TEMPLATE REMINDER DIALOGS")
  1. Q
  1. REMDLGS(TIUY) ;Returns a list of all reminder dialogs usable in templates
  1. N SRV
  1. K TIUY
  1. D RDACCUM(.TIUY,"USR","N")
  1. ;S SRV=$P($G(^VA(200,DUZ,5)),U)
  1. S SRV=$$GETSRV(DUZ)
  1. D RDACCUM(.TIUY,"SRV.`"_+$G(SRV),"N")
  1. D RDACCUM(.TIUY,"DIV","N")
  1. D RDACCUM(.TIUY,"SYS","N")
  1. Q
  1. RDINLST(TIULST,TIUIEN) ; Searches TIULST for TIUIEN
  1. N IDX,RES
  1. S (IDX,RES)=0
  1. F S IDX=$O(TIULST(IDX)) Q:'IDX D Q:+RES
  1. . I $P(TIULST(IDX),U,2)=TIUIEN S RES=1
  1. K TIUIEN
  1. Q RES
  1. REMDLGOK(TIUY,TIUIEN) ;Returns TRUE if the passed in Reminder Dialog IEN is
  1. ; Allowed to be used as a TIU Template
  1. N TIULST,SRV
  1. S TIUY=-1
  1. I '$D(^PXRMD(801.41,+$G(TIUIEN))) Q
  1. ;I $P(^PXRMD(801.41,+$G(TIUIEN),0),U,3)'="" Q
  1. I +$P(^PXRMD(801.41,+$G(TIUIEN),0),U,3)>0 Q ;ICR 3410
  1. S TIUY=1
  1. D RDACCUM(.TIULST,"USR","Q")
  1. I $$RDINLST(.TIULST,TIUIEN) Q
  1. ;S SRV=$P($G(^VA(200,DUZ,5)),U)
  1. S SRV=$$GETSRV(DUZ)
  1. D RDACCUM(.TIULST,"SRV.`"_+$G(SRV),"Q")
  1. I $$RDINLST(.TIULST,TIUIEN) Q
  1. D RDACCUM(.TIULST,"DIV","Q")
  1. I $$RDINLST(.TIULST,TIUIEN) Q
  1. D RDACCUM(.TIULST,"SYS","Q")
  1. I $$RDINLST(.TIULST,TIUIEN) Q
  1. S TIUY=0
  1. Q
  1. OBJACCUM(TIUY,TIULVL) ; Accumulates Reminder Dialog List
  1. D LSTACCUM(.TIUY,TIULVL,"N","TIU TEMPLATE PERSONAL OBJECTS")
  1. Q
  1. PERSOBJS(TIUY) ; Returns the list of Patient Data Objects that are
  1. ; allowed to be used in Personal Templates
  1. N SRV
  1. K TIUY
  1. D OBJACCUM(.TIUY,"USR")
  1. ;S SRV=$P($G(^VA(200,DUZ,5)),U)
  1. S SRV=$$GETSRV(DUZ)
  1. I +SRV D OBJACCUM(.TIUY,"SRV.`"_+$G(SRV))
  1. D OBJACCUM(.TIUY,"DIV")
  1. D OBJACCUM(.TIUY,"SYS")
  1. Q
  1. LOCK(TIUY,TIUDA) ; Lock Template
  1. L +^TIU(8927,TIUDA,0):1
  1. S TIUY=$T
  1. Q
  1. UNLOCK(TIUY,TIUDA) ; Unlock Template
  1. L -^TIU(8927,TIUDA,0):1
  1. S TIUY=1
  1. Q
  1. GETTMPLT(TIUY,TIUDA) ; Returns basic data for template TIUDA in the TIU TEMPLATE FILE 8927.
  1. ;TIUY(1) is returned as a multiple-piece single value delimited by '^'.
  1. ;TIU*1*252
  1. N TIUIDX
  1. D ADDNODE^TIUSRVT(.TIUIDX,TIUDA,1) ;Sets TIUY(1)
  1. Q
  1. GETSRV(NEWPERS) ; Get service section for NEWPERS
  1. Q $$GET1^DIQ(200,NEWPERS_",",29,"I") ;ICR 10060 for VA(200