TIUSRVT2.m

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