TIUSRVT2 ; SLC/JM - Server functions for templates ;3/10/2011
;;1.0;TEXT INTEGRATION UTILITIES;**80,105,249,252**;Jun 20, 1997;Build 6
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") ;ICR 2263
I TIUY="" D
.N TIUCLLST,TIUERR,IDX,TMP
.D GETLST^XPAR(.TIUCLLST,"SYS","TIU TEMPLATE ACCESS BY CLASS","Q",.TIUERR) ;ICR 2263
.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 ;ICR 1544
...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)
.S SERVICE=$$GETSRV(USER)
.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) ;2263
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) ;2263
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)
S SRV=$$GETSRV(DUZ)
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 ;ICR 3410
S TIUY=1
D RDACCUM(.TIULST,"USR","Q")
I $$RDINLST(.TIULST,TIUIEN) Q
;S SRV=$P($G(^VA(200,DUZ,5)),U)
S SRV=$$GETSRV(DUZ)
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)
S SRV=$$GETSRV(DUZ)
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
GETTMPLT(TIUY,TIUDA) ; Returns basic data for template TIUDA in the TIU TEMPLATE FILE 8927.
;TIUY(1) is returned as a multiple-piece single value delimited by '^'.
;TIU*1*252
N TIUIDX
D ADDNODE^TIUSRVT(.TIUIDX,TIUDA,1) ;Sets TIUY(1)
Q
GETSRV(NEWPERS) ; Get service section for NEWPERS
Q $$GET1^DIQ(200,NEWPERS_",",29,"I") ;ICR 10060 for VA(200
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVT2 4118 printed Apr 09, 2024@21:47:43 Page 2
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
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 ;ICR 2263
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 ;ICR 2263
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 ;ICR 1544
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 ;S SERVICE=$P($G(^VA(200,USER,5)),U)
+28 SET SERVICE=$$GETSRV(USER)
+29 IF +SERVICE>0
SET XPARSRCH=XPARSRCH_SERVICE_";DIC(49,"_U
+30 SET XPARSRCH=XPARSRCH_"DIV^SYS"
+31 SET TIUY=$$GET^XPAR(XPARSRCH,"TIU PERSONAL TEMPLATE ACCESS")
End DoDot:1
+32 IF TIUY=""
SET TIUY=0
+33 QUIT
+34 ;
GETDFLT(TIUY) ;Returns Default Templates for the current user
+1 NEW TIUTMP,TIUERR
+2 ;2263
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 ;2263
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 ;S SRV=$P($G(^VA(200,DUZ,5)),U)
+5 SET SRV=$$GETSRV(DUZ)
+6 DO RDACCUM(.TIUY,"SRV.`"_+$GET(SRV),"N")
+7 DO RDACCUM(.TIUY,"DIV","N")
+8 DO RDACCUM(.TIUY,"SYS","N")
+9 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 ;ICR 3410
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 ;S SRV=$P($G(^VA(200,DUZ,5)),U)
+11 SET SRV=$$GETSRV(DUZ)
+12 DO RDACCUM(.TIULST,"SRV.`"_+$GET(SRV),"Q")
+13 IF $$RDINLST(.TIULST,TIUIEN)
QUIT
+14 DO RDACCUM(.TIULST,"DIV","Q")
+15 IF $$RDINLST(.TIULST,TIUIEN)
QUIT
+16 DO RDACCUM(.TIULST,"SYS","Q")
+17 IF $$RDINLST(.TIULST,TIUIEN)
QUIT
+18 SET TIUY=0
+19 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 ;S SRV=$P($G(^VA(200,DUZ,5)),U)
+6 SET SRV=$$GETSRV(DUZ)
+7 IF +SRV
DO OBJACCUM(.TIUY,"SRV.`"_+$GET(SRV))
+8 DO OBJACCUM(.TIUY,"DIV")
+9 DO OBJACCUM(.TIUY,"SYS")
+10 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
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 '^'.
+2 ;TIU*1*252
+3 NEW TIUIDX
+4 ;Sets TIUY(1)
DO ADDNODE^TIUSRVT(.TIUIDX,TIUDA,1)
+5 QUIT
GETSRV(NEWPERS) ; Get service section for NEWPERS
+1 ;ICR 10060 for VA(200
QUIT $$GET1^DIQ(200,NEWPERS_",",29,"I")
