- 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 Jan 18, 2025@03:47:16 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")