source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVT2.m@ 1524

Last change on this file since 1524 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1TIUSRVT2 ; SLC/JM - Server functions for templates ;1/19/2001
2 ;;1.0;TEXT INTEGRATION UTILITIES;**80,105**;Jun 20, 1997
3TACCESS(TIUY,ROOT,USER,LOC) ;Returns Template Access level of User
4 ;
5 ;Return Values:
6 ;
7 ; 0 = FULL ACCESS
8 ; 1 = READ ONLY
9 ; 2 = NO ACCESS
10 ; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
11 ;
12 I +ROOT D Q:+TIUY
13 .D ISEDITOR^TIUSRVT(.TIUY,ROOT,USER)
14 .I +TIUY S TIUY=3
15 .E S TIUY=0
16 S TIUY=$$GET^XPAR(USER_";VA(200,","TIU PERSONAL TEMPLATE ACCESS",1,"I")
17 I TIUY="" D
18 .N TIUCLLST,TIUERR,IDX,TMP
19 .D GETLST^XPAR(.TIUCLLST,"SYS","TIU TEMPLATE ACCESS BY CLASS","Q",.TIUERR)
20 .I TIUERR>0 Q
21 .S IDX=0
22 .F S IDX=$O(TIUCLLST(IDX)) Q:'IDX D
23 ..I $$ISA^USRLM(USER,$P(TIUCLLST(IDX),U),.TIUERR) D
24 ...S TMP=+$P(TIUCLLST(IDX),U,2)
25 ...I +TIUY'>TMP S TIUY=TMP
26 I TIUY="" D
27 .N XPARSRCH,SERVICE
28 .I +$G(LOC) S XPARSRCH=LOC_";SC("_U
29 .E S XPARSRCH=""
30 .S SERVICE=$P($G(^VA(200,USER,5)),U)
31 .I +SERVICE>0 S XPARSRCH=XPARSRCH_SERVICE_";DIC(49,"_U
32 .S XPARSRCH=XPARSRCH_"DIV^SYS"
33 .S TIUY=$$GET^XPAR(XPARSRCH,"TIU PERSONAL TEMPLATE ACCESS")
34 I TIUY="" S TIUY=0
35 Q
36GETDFLT(TIUY) ;Returns Default Templates for the current user
37 N TIUTMP,TIUERR
38 D GETLST^XPAR(.TIUTMP,"USR","TIU DEFAULT TEMPLATES","Q",.TIUERR)
39 S TIUY=$P($G(TIUTMP(1)),U,2)
40 Q
41SETDFLT(TIUY,SETTINGS) ;Saves Default Templates for the user
42 N TIUERR
43 D EN^XPAR(DUZ_";VA(200,","TIU DEFAULT TEMPLATES",1,SETTINGS,.TIUERR)
44 S TIUY=1
45 Q
46LSTACCUM(TIUY,TIULVL,TYP,PARAM) ; Accumulates TIUTMP into TIUY
47 N IDX,I,J,FOUND,TIUERR,TIUTMP
48 D GETLST^XPAR(.TIUTMP,TIULVL,PARAM,TYP,.TIUERR)
49 S I=0,IDX=$O(TIUY(999999),-1)+1
50 F S I=$O(TIUTMP(I)) Q:'I D
51 .S (FOUND,J)=0
52 .F S J=$O(TIUY(J)) Q:'J D Q:FOUND
53 ..I TIUY(J)=TIUTMP(I) S FOUND=1
54 .I 'FOUND D
55 ..S TIUY(IDX)=TIUTMP(I)
56 ..S IDX=IDX+1
57 Q
58RDACCUM(TIUY,TIULVL,TYP) ; Accumulates Reminder Dialog List
59 D LSTACCUM(.TIUY,TIULVL,TYP,"TIU TEMPLATE REMINDER DIALOGS")
60 Q
61REMDLGS(TIUY) ;Returns a list of all reminder dialogs usable in templates
62 N SRV
63 K TIUY
64 D RDACCUM(.TIUY,"USR","N")
65 S SRV=$P($G(^VA(200,DUZ,5)),U)
66 D RDACCUM(.TIUY,"SRV.`"_+$G(SRV),"N")
67 D RDACCUM(.TIUY,"DIV","N")
68 D RDACCUM(.TIUY,"SYS","N")
69 Q
70RDINLST(TIULST,TIUIEN) ; Searches TIULST for TIUIEN
71 N IDX,RES
72 S (IDX,RES)=0
73 F S IDX=$O(TIULST(IDX)) Q:'IDX D Q:+RES
74 . I $P(TIULST(IDX),U,2)=TIUIEN S RES=1
75 K TIUIEN
76 Q RES
77REMDLGOK(TIUY,TIUIEN) ;Returns TRUE if the passed in Reminder Dialog IEN is
78 ; Allowed to be used as a TIU Template
79 N TIULST,SRV
80 S TIUY=-1
81 I '$D(^PXRMD(801.41,+$G(TIUIEN))) Q
82 I $P(^PXRMD(801.41,+$G(TIUIEN),0),U,3)'="" Q
83 S TIUY=1
84 D RDACCUM(.TIULST,"USR","Q")
85 I $$RDINLST(.TIULST,TIUIEN) Q
86 S SRV=$P($G(^VA(200,DUZ,5)),U)
87 D RDACCUM(.TIULST,"SRV.`"_+$G(SRV),"Q")
88 I $$RDINLST(.TIULST,TIUIEN) Q
89 D RDACCUM(.TIULST,"DIV","Q")
90 I $$RDINLST(.TIULST,TIUIEN) Q
91 D RDACCUM(.TIULST,"SYS","Q")
92 I $$RDINLST(.TIULST,TIUIEN) Q
93 S TIUY=0
94 Q
95OBJACCUM(TIUY,TIULVL) ; Accumulates Reminder Dialog List
96 D LSTACCUM(.TIUY,TIULVL,"N","TIU TEMPLATE PERSONAL OBJECTS")
97 Q
98PERSOBJS(TIUY) ; Returns the list of Patient Data Objects that are
99 ; allowed to be used in Personal Templates
100 N SRV
101 K TIUY
102 D OBJACCUM(.TIUY,"USR")
103 S SRV=$P($G(^VA(200,DUZ,5)),U)
104 I +SRV D OBJACCUM(.TIUY,"SRV.`"_+$G(SRV))
105 D OBJACCUM(.TIUY,"DIV")
106 D OBJACCUM(.TIUY,"SYS")
107 Q
108LOCK(TIUY,TIUDA) ; Lock Template
109 L +^TIU(8927,TIUDA,0):1
110 S TIUY=$T
111 Q
112UNLOCK(TIUY,TIUDA) ; Unlock Template
113 L -^TIU(8927,TIUDA,0):1
114 S TIUY=1
115 Q
Note: See TracBrowser for help on using the repository browser.