TIUSRVT2 ; SLC/JM - Server functions for templates ;5/11/2009
;;1.0;TEXT INTEGRATION UTILITIES;**80,105,249**;Jun 20, 1997;Build 48
TACCESS(TIUY,ROOT,USER,LOC) ;Returns Template Access level of User
;
;Return Values:
;
; 0 = FULL ACCESS
; 1 = READ ONLY
; 2 = NO ACCESS
; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
;
I +ROOT D Q:+TIUY
.D ISEDITOR^TIUSRVT(.TIUY,ROOT,USER)
.I +TIUY S TIUY=3
.E S TIUY=0
S TIUY=$$GET^XPAR(USER_";VA(200,","TIU PERSONAL TEMPLATE ACCESS",1,"I")
I TIUY="" D
.N TIUCLLST,TIUERR,IDX,TMP
.D GETLST^XPAR(.TIUCLLST,"SYS","TIU TEMPLATE ACCESS BY CLASS","Q",.TIUERR)
.I TIUERR>0 Q
.S IDX=0
.F S IDX=$O(TIUCLLST(IDX)) Q:'IDX D
..I $$ISA^USRLM(USER,$P(TIUCLLST(IDX),U),.TIUERR) D
...S TMP=+$P(TIUCLLST(IDX),U,2)
...I +TIUY'>TMP S TIUY=TMP
I TIUY="" D
.N XPARSRCH,SERVICE
.I +$G(LOC) S XPARSRCH=LOC_";SC("_U
.E S XPARSRCH=""
.S SERVICE=$P($G(^VA(200,USER,5)),U)
.I +SERVICE>0 S XPARSRCH=XPARSRCH_SERVICE_";DIC(49,"_U
.S XPARSRCH=XPARSRCH_"DIV^SYS"
.S TIUY=$$GET^XPAR(XPARSRCH,"TIU PERSONAL TEMPLATE ACCESS")
I TIUY="" S TIUY=0
Q
GETDFLT(TIUY) ;Returns Default Templates for the current user
N TIUTMP,TIUERR
D GETLST^XPAR(.TIUTMP,"USR","TIU DEFAULT TEMPLATES","Q",.TIUERR)
S TIUY=$P($G(TIUTMP(1)),U,2)
Q
SETDFLT(TIUY,SETTINGS) ;Saves Default Templates for the user
N TIUERR
D EN^XPAR(DUZ_";VA(200,","TIU DEFAULT TEMPLATES",1,SETTINGS,.TIUERR)
S TIUY=1
Q
LSTACCUM(TIUY,TIULVL,TYP,PARAM) ; Accumulates TIUTMP into TIUY
N IDX,I,J,FOUND,TIUERR,TIUTMP
D GETLST^XPAR(.TIUTMP,TIULVL,PARAM,TYP,.TIUERR)
S I=0,IDX=$O(TIUY(999999),-1)+1
F S I=$O(TIUTMP(I)) Q:'I D
.S (FOUND,J)=0
.F S J=$O(TIUY(J)) Q:'J D Q:FOUND
..I TIUY(J)=TIUTMP(I) S FOUND=1
.I 'FOUND D
..S TIUY(IDX)=TIUTMP(I)
..S IDX=IDX+1
Q
RDACCUM(TIUY,TIULVL,TYP) ; Accumulates Reminder Dialog List
D LSTACCUM(.TIUY,TIULVL,TYP,"TIU TEMPLATE REMINDER DIALOGS")
Q
REMDLGS(TIUY) ;Returns a list of all reminder dialogs usable in templates
N SRV
K TIUY
D RDACCUM(.TIUY,"USR","N")
S SRV=$P($G(^VA(200,DUZ,5)),U)
D RDACCUM(.TIUY,"SRV.`"_+$G(SRV),"N")
D RDACCUM(.TIUY,"DIV","N")
D RDACCUM(.TIUY,"SYS","N")
Q
RDINLST(TIULST,TIUIEN) ; Searches TIULST for TIUIEN
N IDX,RES
S (IDX,RES)=0
F S IDX=$O(TIULST(IDX)) Q:'IDX D Q:+RES
. I $P(TIULST(IDX),U,2)=TIUIEN S RES=1
K TIUIEN
Q RES
REMDLGOK(TIUY,TIUIEN) ;Returns TRUE if the passed in Reminder Dialog IEN is
; Allowed to be used as a TIU Template
N TIULST,SRV
S TIUY=-1
I '$D(^PXRMD(801.41,+$G(TIUIEN))) Q
;I $P(^PXRMD(801.41,+$G(TIUIEN),0),U,3)'="" Q
I +$P(^PXRMD(801.41,+$G(TIUIEN),0),U,3)>0 Q
S TIUY=1
D RDACCUM(.TIULST,"USR","Q")
I $$RDINLST(.TIULST,TIUIEN) Q
S SRV=$P($G(^VA(200,DUZ,5)),U)
D RDACCUM(.TIULST,"SRV.`"_+$G(SRV),"Q")
I $$RDINLST(.TIULST,TIUIEN) Q
D RDACCUM(.TIULST,"DIV","Q")
I $$RDINLST(.TIULST,TIUIEN) Q
D RDACCUM(.TIULST,"SYS","Q")
I $$RDINLST(.TIULST,TIUIEN) Q
S TIUY=0
Q
OBJACCUM(TIUY,TIULVL) ; Accumulates Reminder Dialog List
D LSTACCUM(.TIUY,TIULVL,"N","TIU TEMPLATE PERSONAL OBJECTS")
Q
PERSOBJS(TIUY) ; Returns the list of Patient Data Objects that are
; allowed to be used in Personal Templates
N SRV
K TIUY
D OBJACCUM(.TIUY,"USR")
S SRV=$P($G(^VA(200,DUZ,5)),U)
I +SRV D OBJACCUM(.TIUY,"SRV.`"_+$G(SRV))
D OBJACCUM(.TIUY,"DIV")
D OBJACCUM(.TIUY,"SYS")
Q
LOCK(TIUY,TIUDA) ; Lock Template
L +^TIU(8927,TIUDA,0):1
S TIUY=$T
Q
UNLOCK(TIUY,TIUDA) ; Unlock Template
L -^TIU(8927,TIUDA,0):1
S TIUY=1
Q
TIUSRVT2 ; SLC/JM - Server functions for templates ;5/11/2009
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**80,105,249**;Jun 20, 1997;Build 48
TACCESS(TIUY,ROOT,USER,LOC) ;Returns Template Access level of User
+1 ;
+2 ;Return Values:
+3 ;
+4 ; 0 = FULL ACCESS
+5 ; 1 = READ ONLY
+6 ; 2 = NO ACCESS
+7 ; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
+8 ;
+9 IF +ROOT
Begin DoDot:1
+10 DO ISEDITOR^TIUSRVT(.TIUY,ROOT,USER)
+11 IF +TIUY
SET TIUY=3
+12 IF '$TEST
SET TIUY=0
End DoDot:1
IF +TIUY
QUIT
+13 SET TIUY=$$GET^XPAR(USER_";VA(200,","TIU PERSONAL TEMPLATE ACCESS",1,"I")
+14 IF TIUY=""
Begin DoDot:1
+15 NEW TIUCLLST,TIUERR,IDX,TMP
+16 DO GETLST^XPAR(.TIUCLLST,"SYS","TIU TEMPLATE ACCESS BY CLASS","Q",.TIUERR)
+17 IF TIUERR>0
QUIT
+18 SET IDX=0
+19 FOR
SET IDX=$ORDER(TIUCLLST(IDX))
IF 'IDX
QUIT
Begin DoDot:2
+20 IF $$ISA^USRLM(USER,$PIECE(TIUCLLST(IDX),U),.TIUERR)
Begin DoDot:3
+21 SET TMP=+$PIECE(TIUCLLST(IDX),U,2)
+22 IF +TIUY'>TMP
SET TIUY=TMP
End DoDot:3
End DoDot:2
End DoDot:1
+23 IF TIUY=""
Begin DoDot:1
+24 NEW XPARSRCH,SERVICE
+25 IF +$GET(LOC)
SET XPARSRCH=LOC_";SC("_U
+26 IF '$TEST
SET XPARSRCH=""
+27 SET SERVICE=$PIECE($GET(^VA(200,USER,5)),U)
+28 IF +SERVICE>0
SET XPARSRCH=XPARSRCH_SERVICE_";DIC(49,"_U
+29 SET XPARSRCH=XPARSRCH_"DIV^SYS"
+30 SET TIUY=$$GET^XPAR(XPARSRCH,"TIU PERSONAL TEMPLATE ACCESS")
End DoDot:1
+31 IF TIUY=""
SET TIUY=0
+32 QUIT
GETDFLT(TIUY) ;Returns Default Templates for the current user
+1 NEW TIUTMP,TIUERR
+2 DO GETLST^XPAR(.TIUTMP,"USR","TIU DEFAULT TEMPLATES","Q",.TIUERR)
+3 SET TIUY=$PIECE($GET(TIUTMP(1)),U,2)
+4 QUIT
SETDFLT(TIUY,SETTINGS) ;Saves Default Templates for the user
+1 NEW TIUERR
+2 DO EN^XPAR(DUZ_";VA(200,","TIU DEFAULT TEMPLATES",1,SETTINGS,.TIUERR)
+3 SET TIUY=1
+4 QUIT
LSTACCUM(TIUY,TIULVL,TYP,PARAM) ; Accumulates TIUTMP into TIUY
+1 NEW IDX,I,J,FOUND,TIUERR,TIUTMP
+2 DO GETLST^XPAR(.TIUTMP,TIULVL,PARAM,TYP,.TIUERR)
+3 SET I=0
SET IDX=$ORDER(TIUY(999999),-1)+1
+4 FOR
SET I=$ORDER(TIUTMP(I))
IF 'I
QUIT
Begin DoDot:1
+5 SET (FOUND,J)=0
+6 FOR
SET J=$ORDER(TIUY(J))
IF 'J
QUIT
Begin DoDot:2
+7 IF TIUY(J)=TIUTMP(I)
SET FOUND=1
End DoDot:2
IF FOUND
QUIT
+8 IF 'FOUND
Begin DoDot:2
+9 SET TIUY(IDX)=TIUTMP(I)
+10 SET IDX=IDX+1
End DoDot:2
End DoDot:1
+11 QUIT
RDACCUM(TIUY,TIULVL,TYP) ; Accumulates Reminder Dialog List
+1 DO LSTACCUM(.TIUY,TIULVL,TYP,"TIU TEMPLATE REMINDER DIALOGS")
+2 QUIT
REMDLGS(TIUY) ;Returns a list of all reminder dialogs usable in templates
+1 NEW SRV
+2 KILL TIUY
+3 DO RDACCUM(.TIUY,"USR","N")
+4 SET SRV=$PIECE($GET(^VA(200,DUZ,5)),U)
+5 DO RDACCUM(.TIUY,"SRV.`"_+$GET(SRV),"N")
+6 DO RDACCUM(.TIUY,"DIV","N")
+7 DO RDACCUM(.TIUY,"SYS","N")
+8 QUIT
RDINLST(TIULST,TIUIEN) ; Searches TIULST for TIUIEN
+1 NEW IDX,RES
+2 SET (IDX,RES)=0
+3 FOR
SET IDX=$ORDER(TIULST(IDX))
IF 'IDX
QUIT
Begin DoDot:1
+4 IF $PIECE(TIULST(IDX),U,2)=TIUIEN
SET RES=1
End DoDot:1
IF +RES
QUIT
+5 KILL TIUIEN
+6 QUIT RES
REMDLGOK(TIUY,TIUIEN) ;Returns TRUE if the passed in Reminder Dialog IEN is
+1 ; Allowed to be used as a TIU Template
+2 NEW TIULST,SRV
+3 SET TIUY=-1
+4 IF '$DATA(^PXRMD(801.41,+$GET(TIUIEN)))
QUIT
+5 ;I $P(^PXRMD(801.41,+$G(TIUIEN),0),U,3)'="" Q
+6 IF +$PIECE(^PXRMD(801.41,+$GET(TIUIEN),0),U,3)>0
QUIT
+7 SET TIUY=1
+8 DO RDACCUM(.TIULST,"USR","Q")
+9 IF $$RDINLST(.TIULST,TIUIEN)
QUIT
+10 SET SRV=$PIECE($GET(^VA(200,DUZ,5)),U)
+11 DO RDACCUM(.TIULST,"SRV.`"_+$GET(SRV),"Q")
+12 IF $$RDINLST(.TIULST,TIUIEN)
QUIT
+13 DO RDACCUM(.TIULST,"DIV","Q")
+14 IF $$RDINLST(.TIULST,TIUIEN)
QUIT
+15 DO RDACCUM(.TIULST,"SYS","Q")
+16 IF $$RDINLST(.TIULST,TIUIEN)
QUIT
+17 SET TIUY=0
+18 QUIT
OBJACCUM(TIUY,TIULVL) ; Accumulates Reminder Dialog List
+1 DO LSTACCUM(.TIUY,TIULVL,"N","TIU TEMPLATE PERSONAL OBJECTS")
+2 QUIT
PERSOBJS(TIUY) ; Returns the list of Patient Data Objects that are
+1 ; allowed to be used in Personal Templates
+2 NEW SRV
+3 KILL TIUY
+4 DO OBJACCUM(.TIUY,"USR")
+5 SET SRV=$PIECE($GET(^VA(200,DUZ,5)),U)
+6 IF +SRV
DO OBJACCUM(.TIUY,"SRV.`"_+$GET(SRV))
+7 DO OBJACCUM(.TIUY,"DIV")
+8 DO OBJACCUM(.TIUY,"SYS")
+9 QUIT
LOCK(TIUY,TIUDA) ; Lock Template
+1 LOCK +^TIU(8927,TIUDA,0):1
+2 SET TIUY=$TEST
+3 QUIT
UNLOCK(TIUY,TIUDA) ; Unlock Template
+1 LOCK -^TIU(8927,TIUDA,0):1
+2 SET TIUY=1
+3 QUIT
