TIULP ; SLC/JER - Functions determining privilege ; 12/13/10 3:45pm
;;1.0;TEXT INTEGRATION UTILITIES;**98,100,116,109,138,152,175,157,182,184,217,236,234,232,241**;Jun 20, 1997;Build 7
; CANDO^USRLA: ICA 2325, ISA^USRLM: ICA 2324
; 8930.1,2,8: IACS 3129,3128,3104
CANDO(TIUDA,TIUACT,PERSON) ; Can PERSON perform action now
; Receives: TIUDA=Record number in file 8925
; TIUACT=Name of user action in 8930.8 (USR ACTION)
; PERSON=New Person file IFN.
; Assumed to be DUZ if not received.
; New **100** ID param, backward compatible.
; Returns: TIUY=1:yes,0:no_"^"_why not message
N TIUI,TIUTYP,TIUROLE,STATUS,TIUY,TIUATYP,MSG,WHO,MODIFIER,TIUD0,TIUACTW
S TIUY=0 I '$G(PERSON) S PERSON=DUZ
S TIUD0=$G(^TIU(8925,+TIUDA,0)) I 'TIUD0 G CANDOX
I $$ISPRFDOC^TIUPRF(TIUDA),((TIUACT="ATTACH ID ENTRY")!(TIUACT="ATTACH TO ID NOTE")) S TIUY="0^Patient Record Flag notes may not be used as Interdisciplinary notes." G CANDOX
S TIUACTW=$G(TIUACT)
;**100** was I +TIUACT'>0 S TIUACT etc.
S TIUACT=$$USREVNT(TIUACT) I +TIUACT'>0 G CANDOX
; -- Historical Procedures - Prohibit actions detailed in
; HPCAN^TIUCP: P182
N HPCAN I $$ISHISTCP^TIUCP(+TIUD0) S HPCAN=$$HPCAN^TIUCP(+TIUACT) I 'HPCAN S TIUY=HPCAN G CANDOX
; **152 Get status
S STATUS=+$P(TIUD0,U,5)
; **152[234] prevents editing or sending back a completed or uncosigned document.
I STATUS>5,(+TIUACT=9)!(+TIUACT=17) D G CANDOX
. ; **152[234] Displays message to user
. I +TIUACT=9 S TIUY="0^ You may not edit uncosigned or completed documents."
. I +TIUACT=17 S TIUY="0^You may not send back uncosigned or completed documents."
; -- In case business rules have changed, & children already existed:
I +TIUACT=24,$D(^TIU(8925,"GDAD",TIUDA)) D G CANDOX
. S TIUY="0^ This note cannot be attached; it has its own children."
I +TIUACT=25,+$G(^TIU(8925,TIUDA,21)) D G CANDOX
. S TIUY="0^ This note cannot receive interdisciplinary children; it is itself a child."
;VMP/AM P241 If note is administratively closed, then bypass check for blank characters
I $P($G(^TIU(8925,+TIUDA,16)),U,13)'="S",+TIUACT=4!(+TIUACT=5),+$$BLANK^TIULC(TIUDA) D G CANDOX ;Sets TIUPRM1
. S TIUY="0^ Contains blanks ("_$P(TIUPRM1,U,6)_") which must be filled before "_$P(TIUACT,U,2)_"ATURE."
S TIUROLE=$$USRROLE(TIUDA,PERSON)
S TIUTYP=+TIUD0
I $$ISADDNDM^TIULC1(+TIUDA) S TIUATYP=TIUTYP,TIUTYP=+$G(^TIU(8925,+$P(TIUD0,U,6),0))
I TIUROLE']"" S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,PERSON)
F TIUI=1:1:($L(TIUROLE,U)-1) D Q:+$G(TIUY)>0
. S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,PERSON,$P(TIUROLE,U,TIUI))
I +$G(TIUATYP) S TIUTYP=+$G(TIUATYP)
;**100** update for PERSON param; update for verb modifier:
I +TIUY'>0 D G CANDOX
. S WHO=" You"
. ;I PERSON'=DUZ S WHO=$P(^VA(200,PERSON,0),U),WHO=$$NAME^TIULS(WHO,"FIRST LAST")
. I PERSON'=DUZ S WHO=$$NAME^TIULS($$GET1^DIQ(200,PERSON,.01),"FIRST LAST") ;P182
. S MODIFIER=$P(TIUACT,U,3) I $L(MODIFIER) S MODIFIER=" "_MODIFIER
. ;e.g. "You may not ATTACH this UNSIGNED TELEPHONE NOTE TO AN ID NOTE."
. S MSG=WHO_" may not "_$P(TIUACT,U,2)_" this "_$P($G(^TIU(8925.6,+STATUS,0)),U)_" "_$$PNAME^TIULC1(TIUTYP)_MODIFIER_"."
. S TIUY=TIUY_U_MSG
I +TIUACT=15,$$HASIMG^TIURB2(+TIUDA) D G CANDOX
. S TIUY="0^ This document contains linked images. You must ""delete"" the Images using the Imaging package before proceeding."
;VMP/ELR P217. Do not allow deletion of a parent with child
I $G(TIUACTW)["DELETE RECORD",$$HASIDKID^TIUGBR(+TIUDA) D G CANDOX
. ;VMP/ELR P232. Create new error msg.
. NEW TIUMSG D IDMSG^TIULP3(.TIUMSG) S TIUY="0^"_TIUMSG
;VMP/ELR P232 do not allow edit, delete or addendum on NIR and Anesthesia report IA3356 FOR XQY0
I (($G(XQY0)["OR CPRS GUI CHART")!($G(XQY0)["TIU ")),$$ACTION^TIULP3($G(TIUACTW)),$$ISSURG^TIULP3(+TIUDA) D G CANDOX
. S TIUY="0^ "_$$SURMSG^TIULP3($G(TIUACTW))
CANDOX Q TIUY
;
CANLINK(TIUTYP) ; Can user (DUZ) link (attach) a document of a particular type
;to an ID note.
; For use in ADD NEW ID NOTE, where docmt is not entered yet.
; Assume most favorable circumstances (user will complete
;the note, so if user still can't attach, can tell them no,
;when they first select title for the new entry.
; Rule out if TIUTYP can be an ID parent, since ID parent
;and ID kid function as mutually exclusive, (regardless of
;business rules).
N TIUACT,STATUS,USRROLE,TIUY
S TIUACT=$$USREVNT("ATTACH TO ID NOTE"),STATUS=7 ; complete
S USRROLE=+$O(^USR(8930.2,"B","COMPLETER",0))
S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,DUZ,USRROLE)
I '$G(TIUY) S TIUY="0^ You may not use this title for interdisciplinary child entries." Q TIUY
; -- If user can attach a certain note, but note can also receive
; ID entries, don't let user attach it. --
I $$POSSPRNT^TIULP(TIUTYP) S TIUY="0^ This interdisciplinary PARENT title cannot be used for CHILD entries."
; -- If selected type is a CWAD, don't let user attach it: --
I $$ISCWAD^TIULX(TIUTYP) S TIUY="0^ CWAD titles cannot be used for interdisciplinary entries."
; -- If selected type is a PRF, don't let user attach it: --
I $$ISPFTTL^TIUPRFL(TIUTYP) S TIUY="0^ Patient Record Flag titles cannot be used for interdisciplinary entries."
; -- If selected type is a consult, don't let user attach it: --
I $$ISA^TIULX(TIUTYP,+$$CLASS^TIUCNSLT) S TIUY="0^ Consult titles cannot be used for interdisciplinary entries."
Q TIUY
;
POSSPRNT(TIUTYP) ; Is a docmt intended as a possible ID parent?
;Returns 1^WHYCAN'TATTACH if there are business rules permitting ANYONE
;to attach ID entries to notes of type TIUTYP.
;Else returns 0.
N TIUACT,STATUS,TIUY,DADTYP
S TIUY=0,TIUACT=+$$USREVNT("ATTACH ID ENTRY")
F STATUS=6,7,8 D G:TIUY POSSX
. I $O(^USR(8930.1,"AR",TIUTYP,STATUS,TIUACT,0)) S TIUY=1 Q
. I $O(^USR(8930.1,"AC",TIUTYP,STATUS,TIUACT,0)) S TIUY=1
; -- If no rules for TIUTYP, try its parent: --
S DADTYP=$O(^TIU(8925.1,"AD",TIUTYP,0)) G:DADTYP'>0 POSSX
S TIUY=$$POSSPRNT(DADTYP)
POSSX I TIUY S TIUY="1^ Interdisciplinary PARENT notes cannot be attached as CHILD entries."
Q TIUY
;
CANENTR(TIUTYP) ; Evaluate privilege to enter a document of a particular type
N TIUACT,STATUS,USRROLE,TIUY
S TIUACT=$$USREVNT("ENTRY"),STATUS=2 ; untranscribed
S USRROLE=3 ; transcriber
S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,DUZ,USRROLE)
Q TIUY
USRROLE(TIUDA,PERSON) ; Identify the user's role with respect to the document
; 3/20/00 **100** Added role COMPLETER
; 3/20/00 **100** Added PERSON param
N TIU0,TIU12,TIU13,TIUY,TIU15,COMPLTR,STATUS
S PERSON=$G(PERSON,DUZ)
S TIU0=$G(^TIU(8925,+TIUDA,0)),STATUS=$P(TIU0,U,5)
S TIU12=$G(^TIU(8925,+TIUDA,12))
S TIU13=$G(^TIU(8925,+TIUDA,13)),TIU15=$G(^TIU(8925,+TIUDA,15))
I PERSON=+$P(TIU13,U,2) S TIUY=+$O(^USR(8930.2,"B","TRANSCRIBER",0))_U
I PERSON=+$P(TIU12,U,2) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","AUTHOR/DICTATOR",0))_U
I PERSON=+$P(TIU12,U,9) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","ATTENDING PHYSICIAN",0))_U
I PERSON=+$P(TIU12,U,4) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","EXPECTED SIGNER",0))_U
I PERSON=+$P(TIU12,U,8) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","EXPECTED COSIGNER",0))_U
I $$ASURG^TIUADSIG(TIUDA) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","SURROGATE",0))_U ;P157
;Check if the person can be an Interpreter for this document via a Consult API
I $$CPINTERP^GMRCCP(+TIUDA,PERSON) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","INTERPRETER",0))_U
I STATUS>6 D I COMPLTR S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","COMPLETER",0))_U
. S COMPLTR=0
. I PERSON=+$P(TIU15,U,8) S COMPLTR=1 Q
. I '$P(TIU15,U,8),PERSON=+$P(TIU15,U,2) S COMPLTR=1
I +$O(^TIU(8925.7,"AE",+TIUDA,+PERSON,0)) D
. N TIUXTRA S TIUXTRA=+$O(^TIU(8925.7,"AE",+TIUDA,+PERSON,0))
. I +$P($G(^TIU(8925.7,+TIUXTRA,0)),U,4) Q
. S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","ADDITIONAL SIGNER",0))_U
Q $G(TIUY)
USREVNT(EVENT) ; Given event name, return:
;EVENT = event pointer^user verb^verb modifier
; **100** added verb modifier piece (.07)
N TIUY,TIUDA,NODE0
S TIUDA=+$O(^USR(8930.8,"B",EVENT,0))
S NODE0=$G(^USR(8930.8,TIUDA,0))
S TIUY=TIUDA_U_$P(NODE0,U,5)_U_$P(NODE0,U,7)
Q TIUY
CANPICK(TIUTYP) ; Screens selection of title by title status and
;(for status TEST), by owner.
N TIUPOWN,TIUCOWN,TIUT0,TIUTSTAT,TIUY S TIUY=0
S TIUT0=$G(^TIU(8925.1,+TIUTYP,0)),TIUTSTAT=$P(TIUT0,U,7)
I TIUTSTAT']"" S TIUY=0 G CANPIX
I TIUTSTAT=13 S TIUY=0 G CANPIX
I TIUTSTAT=11 S TIUY=1 G CANPIX
S TIUPOWN=$P(TIUT0,U,5),TIUCOWN=+$P(TIUT0,U,6)
I TIUTSTAT=10 S TIUY=$S(TIUPOWN=DUZ:1,+$$ISA^USRLM(DUZ,TIUCOWN):1,1:0)
CANPIX Q +$G(TIUY)
REQCOSIG(TIUTYP,TIUDA,USER,TIUDT) ; Evaluate whether user requires cosignature
N TIUI,TIUY,TIUDPRM S USER=$S(+$G(USER):+$G(USER),1:+$G(DUZ))
D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,+$G(TIUDA))
I $G(TIUDPRM(5))="" G REQCOSX
I +$G(TIUDT)'>0 S TIUDT=+$P($P(+$G(^TIU(8925,+$G(TIUDA),13)),U),".")
F TIUI=1:1:$L(TIUDPRM(5),U) D Q:+TIUY>0
. S TIUY=+$$ISA^USRLM(+USER,+$P(TIUDPRM(5),U,TIUI),,+$G(TIUDT))
REQCOSX Q +$G(TIUY)
;
REQCPF(TIUCDA) ;Check if clinical procedure fields are required
; Input -- TIUCDA Request/Consult File (#123) IEN
; Output -- 1=Required and 0=Not Required
N TIUCPACT,REQF
I '$G(TIUCDA) G REQCPFQ
S TIUCPACT=$$CPACTM^GMRCCP(TIUCDA)
I TIUCPACT=1!(TIUCPACT=3) S REQF=1
REQCPFQ Q +$G(REQF)
TIULP ; SLC/JER - Functions determining privilege ; 12/13/10 3:45pm
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**98,100,116,109,138,152,175,157,182,184,217,236,234,232,241**;Jun 20, 1997;Build 7
+2 ; CANDO^USRLA: ICA 2325, ISA^USRLM: ICA 2324
+3 ; 8930.1,2,8: IACS 3129,3128,3104
CANDO(TIUDA,TIUACT,PERSON) ; Can PERSON perform action now
+1 ; Receives: TIUDA=Record number in file 8925
+2 ; TIUACT=Name of user action in 8930.8 (USR ACTION)
+3 ; PERSON=New Person file IFN.
+4 ; Assumed to be DUZ if not received.
+5 ; New **100** ID param, backward compatible.
+6 ; Returns: TIUY=1:yes,0:no_"^"_why not message
+7 NEW TIUI,TIUTYP,TIUROLE,STATUS,TIUY,TIUATYP,MSG,WHO,MODIFIER,TIUD0,TIUACTW
+8 SET TIUY=0
IF '$GET(PERSON)
SET PERSON=DUZ
+9 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
IF 'TIUD0
GOTO CANDOX
+10 IF $$ISPRFDOC^TIUPRF(TIUDA)
IF ((TIUACT="ATTACH ID ENTRY")!(TIUACT="ATTACH TO ID NOTE"))
SET TIUY="0^Patient Record Flag notes may not be used as Interdisciplinary notes."
GOTO CANDOX
+11 SET TIUACTW=$GET(TIUACT)
+12 ;**100** was I +TIUACT'>0 S TIUACT etc.
+13 SET TIUACT=$$USREVNT(TIUACT)
IF +TIUACT'>0
GOTO CANDOX
+14 ; -- Historical Procedures - Prohibit actions detailed in
+15 ; HPCAN^TIUCP: P182
+16 NEW HPCAN
IF $$ISHISTCP^TIUCP(+TIUD0)
SET HPCAN=$$HPCAN^TIUCP(+TIUACT)
IF 'HPCAN
SET TIUY=HPCAN
GOTO CANDOX
+17 ; **152 Get status
+18 SET STATUS=+$PIECE(TIUD0,U,5)
+19 ; **152[234] prevents editing or sending back a completed or uncosigned document.
+20 IF STATUS>5
IF (+TIUACT=9)!(+TIUACT=17)
Begin DoDot:1
+21 ; **152[234] Displays message to user
+22 IF +TIUACT=9
SET TIUY="0^ You may not edit uncosigned or completed documents."
+23 IF +TIUACT=17
SET TIUY="0^You may not send back uncosigned or completed documents."
End DoDot:1
GOTO CANDOX
+24 ; -- In case business rules have changed, & children already existed:
+25 IF +TIUACT=24
IF $DATA(^TIU(8925,"GDAD",TIUDA))
Begin DoDot:1
+26 SET TIUY="0^ This note cannot be attached; it has its own children."
End DoDot:1
GOTO CANDOX
+27 IF +TIUACT=25
IF +$GET(^TIU(8925,TIUDA,21))
Begin DoDot:1
+28 SET TIUY="0^ This note cannot receive interdisciplinary children; it is itself a child."
End DoDot:1
GOTO CANDOX
+29 ;VMP/AM P241 If note is administratively closed, then bypass check for blank characters
+30 ;Sets TIUPRM1
IF $PIECE($GET(^TIU(8925,+TIUDA,16)),U,13)'="S"
IF +TIUACT=4!(+TIUACT=5)
IF +$$BLANK^TIULC(TIUDA)
Begin DoDot:1
+31 SET TIUY="0^ Contains blanks ("_$PIECE(TIUPRM1,U,6)_") which must be filled before "_$PIECE(TIUACT,U,2)_"ATURE."
End DoDot:1
GOTO CANDOX
+32 SET TIUROLE=$$USRROLE(TIUDA,PERSON)
+33 SET TIUTYP=+TIUD0
+34 IF $$ISADDNDM^TIULC1(+TIUDA)
SET TIUATYP=TIUTYP
SET TIUTYP=+$GET(^TIU(8925,+$PIECE(TIUD0,U,6),0))
+35 IF TIUROLE']""
SET TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,PERSON)
+36 FOR TIUI=1:1:($LENGTH(TIUROLE,U)-1)
Begin DoDot:1
+37 SET TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,PERSON,$PIECE(TIUROLE,U,TIUI))
End DoDot:1
IF +$GET(TIUY)>0
QUIT
+38 IF +$GET(TIUATYP)
SET TIUTYP=+$GET(TIUATYP)
+39 ;**100** update for PERSON param; update for verb modifier:
+40 IF +TIUY'>0
Begin DoDot:1
+41 SET WHO=" You"
+42 ;I PERSON'=DUZ S WHO=$P(^VA(200,PERSON,0),U),WHO=$$NAME^TIULS(WHO,"FIRST LAST")
+43 ;P182
IF PERSON'=DUZ
SET WHO=$$NAME^TIULS($$GET1^DIQ(200,PERSON,.01),"FIRST LAST")
+44 SET MODIFIER=$PIECE(TIUACT,U,3)
IF $LENGTH(MODIFIER)
SET MODIFIER=" "_MODIFIER
+45 ;e.g. "You may not ATTACH this UNSIGNED TELEPHONE NOTE TO AN ID NOTE."
+46 SET MSG=WHO_" may not "_$PIECE(TIUACT,U,2)_" this "_$PIECE($GET(^TIU(8925.6,+STATUS,0)),U)_" "_$$PNAME^TIULC1(TIUTYP)_MODIFIER_"."
+47 SET TIUY=TIUY_U_MSG
End DoDot:1
GOTO CANDOX
+48 IF +TIUACT=15
IF $$HASIMG^TIURB2(+TIUDA)
Begin DoDot:1
+49 SET TIUY="0^ This document contains linked images. You must ""delete"" the Images using the Imaging package before proceeding."
End DoDot:1
GOTO CANDOX
+50 ;VMP/ELR P217. Do not allow deletion of a parent with child
+51 IF $GET(TIUACTW)["DELETE RECORD"
IF $$HASIDKID^TIUGBR(+TIUDA)
Begin DoDot:1
+52 ;VMP/ELR P232. Create new error msg.
+53 NEW TIUMSG
DO IDMSG^TIULP3(.TIUMSG)
SET TIUY="0^"_TIUMSG
End DoDot:1
GOTO CANDOX
+54 ;VMP/ELR P232 do not allow edit, delete or addendum on NIR and Anesthesia report IA3356 FOR XQY0
+55 IF (($GET(XQY0)["OR CPRS GUI CHART")!($GET(XQY0)["TIU "))
IF $$ACTION^TIULP3($GET(TIUACTW))
IF $$ISSURG^TIULP3(+TIUDA)
Begin DoDot:1
+56 SET TIUY="0^ "_$$SURMSG^TIULP3($GET(TIUACTW))
End DoDot:1
GOTO CANDOX
CANDOX QUIT TIUY
+1 ;
CANLINK(TIUTYP) ; Can user (DUZ) link (attach) a document of a particular type
+1 ;to an ID note.
+2 ; For use in ADD NEW ID NOTE, where docmt is not entered yet.
+3 ; Assume most favorable circumstances (user will complete
+4 ;the note, so if user still can't attach, can tell them no,
+5 ;when they first select title for the new entry.
+6 ; Rule out if TIUTYP can be an ID parent, since ID parent
+7 ;and ID kid function as mutually exclusive, (regardless of
+8 ;business rules).
+9 NEW TIUACT,STATUS,USRROLE,TIUY
+10 ; complete
SET TIUACT=$$USREVNT("ATTACH TO ID NOTE")
SET STATUS=7
+11 SET USRROLE=+$ORDER(^USR(8930.2,"B","COMPLETER",0))
+12 SET TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,DUZ,USRROLE)
+13 IF '$GET(TIUY)
SET TIUY="0^ You may not use this title for interdisciplinary child entries."
QUIT TIUY
+14 ; -- If user can attach a certain note, but note can also receive
+15 ; ID entries, don't let user attach it. --
+16 IF $$POSSPRNT^TIULP(TIUTYP)
SET TIUY="0^ This interdisciplinary PARENT title cannot be used for CHILD entries."
+17 ; -- If selected type is a CWAD, don't let user attach it: --
+18 IF $$ISCWAD^TIULX(TIUTYP)
SET TIUY="0^ CWAD titles cannot be used for interdisciplinary entries."
+19 ; -- If selected type is a PRF, don't let user attach it: --
+20 IF $$ISPFTTL^TIUPRFL(TIUTYP)
SET TIUY="0^ Patient Record Flag titles cannot be used for interdisciplinary entries."
+21 ; -- If selected type is a consult, don't let user attach it: --
+22 IF $$ISA^TIULX(TIUTYP,+$$CLASS^TIUCNSLT)
SET TIUY="0^ Consult titles cannot be used for interdisciplinary entries."
+23 QUIT TIUY
+24 ;
POSSPRNT(TIUTYP) ; Is a docmt intended as a possible ID parent?
+1 ;Returns 1^WHYCAN'TATTACH if there are business rules permitting ANYONE
+2 ;to attach ID entries to notes of type TIUTYP.
+3 ;Else returns 0.
+4 NEW TIUACT,STATUS,TIUY,DADTYP
+5 SET TIUY=0
SET TIUACT=+$$USREVNT("ATTACH ID ENTRY")
+6 FOR STATUS=6,7,8
Begin DoDot:1
+7 IF $ORDER(^USR(8930.1,"AR",TIUTYP,STATUS,TIUACT,0))
SET TIUY=1
QUIT
+8 IF $ORDER(^USR(8930.1,"AC",TIUTYP,STATUS,TIUACT,0))
SET TIUY=1
End DoDot:1
IF TIUY
GOTO POSSX
+9 ; -- If no rules for TIUTYP, try its parent: --
+10 SET DADTYP=$ORDER(^TIU(8925.1,"AD",TIUTYP,0))
IF DADTYP'>0
GOTO POSSX
+11 SET TIUY=$$POSSPRNT(DADTYP)
POSSX IF TIUY
SET TIUY="1^ Interdisciplinary PARENT notes cannot be attached as CHILD entries."
+1 QUIT TIUY
+2 ;
CANENTR(TIUTYP) ; Evaluate privilege to enter a document of a particular type
+1 NEW TIUACT,STATUS,USRROLE,TIUY
+2 ; untranscribed
SET TIUACT=$$USREVNT("ENTRY")
SET STATUS=2
+3 ; transcriber
SET USRROLE=3
+4 SET TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,DUZ,USRROLE)
+5 QUIT TIUY
USRROLE(TIUDA,PERSON) ; Identify the user's role with respect to the document
+1 ; 3/20/00 **100** Added role COMPLETER
+2 ; 3/20/00 **100** Added PERSON param
+3 NEW TIU0,TIU12,TIU13,TIUY,TIU15,COMPLTR,STATUS
+4 SET PERSON=$GET(PERSON,DUZ)
+5 SET TIU0=$GET(^TIU(8925,+TIUDA,0))
SET STATUS=$PIECE(TIU0,U,5)
+6 SET TIU12=$GET(^TIU(8925,+TIUDA,12))
+7 SET TIU13=$GET(^TIU(8925,+TIUDA,13))
SET TIU15=$GET(^TIU(8925,+TIUDA,15))
+8 IF PERSON=+$PIECE(TIU13,U,2)
SET TIUY=+$ORDER(^USR(8930.2,"B","TRANSCRIBER",0))_U
+9 IF PERSON=+$PIECE(TIU12,U,2)
SET TIUY=$GET(TIUY)_+$ORDER(^USR(8930.2,"B","AUTHOR/DICTATOR",0))_U
+10 IF PERSON=+$PIECE(TIU12,U,9)
SET TIUY=$GET(TIUY)_+$ORDER(^USR(8930.2,"B","ATTENDING PHYSICIAN",0))_U
+11 IF PERSON=+$PIECE(TIU12,U,4)
SET TIUY=$GET(TIUY)_+$ORDER(^USR(8930.2,"B","EXPECTED SIGNER",0))_U
+12 IF PERSON=+$PIECE(TIU12,U,8)
SET TIUY=$GET(TIUY)_+$ORDER(^USR(8930.2,"B","EXPECTED COSIGNER",0))_U
+13 ;P157
IF $$ASURG^TIUADSIG(TIUDA)
SET TIUY=$GET(TIUY)_+$ORDER(^USR(8930.2,"B","SURROGATE",0))_U
+14 ;Check if the person can be an Interpreter for this document via a Consult API
+15 IF $$CPINTERP^GMRCCP(+TIUDA,PERSON)
SET TIUY=$GET(TIUY)_+$ORDER(^USR(8930.2,"B","INTERPRETER",0))_U
+16 IF STATUS>6
Begin DoDot:1
+17 SET COMPLTR=0
+18 IF PERSON=+$PIECE(TIU15,U,8)
SET COMPLTR=1
QUIT
+19 IF '$PIECE(TIU15,U,8)
IF PERSON=+$PIECE(TIU15,U,2)
SET COMPLTR=1
End DoDot:1
IF COMPLTR
SET TIUY=$GET(TIUY)_+$ORDER(^USR(8930.2,"B","COMPLETER",0))_U
+20 IF +$ORDER(^TIU(8925.7,"AE",+TIUDA,+PERSON,0))
Begin DoDot:1
+21 NEW TIUXTRA
SET TIUXTRA=+$ORDER(^TIU(8925.7,"AE",+TIUDA,+PERSON,0))
+22 IF +$PIECE($GET(^TIU(8925.7,+TIUXTRA,0)),U,4)
QUIT
+23 SET TIUY=$GET(TIUY)_+$ORDER(^USR(8930.2,"B","ADDITIONAL SIGNER",0))_U
End DoDot:1
+24 QUIT $GET(TIUY)
USREVNT(EVENT) ; Given event name, return:
+1 ;EVENT = event pointer^user verb^verb modifier
+2 ; **100** added verb modifier piece (.07)
+3 NEW TIUY,TIUDA,NODE0
+4 SET TIUDA=+$ORDER(^USR(8930.8,"B",EVENT,0))
+5 SET NODE0=$GET(^USR(8930.8,TIUDA,0))
+6 SET TIUY=TIUDA_U_$PIECE(NODE0,U,5)_U_$PIECE(NODE0,U,7)
+7 QUIT TIUY
CANPICK(TIUTYP) ; Screens selection of title by title status and
+1 ;(for status TEST), by owner.
+2 NEW TIUPOWN,TIUCOWN,TIUT0,TIUTSTAT,TIUY
SET TIUY=0
+3 SET TIUT0=$GET(^TIU(8925.1,+TIUTYP,0))
SET TIUTSTAT=$PIECE(TIUT0,U,7)
+4 IF TIUTSTAT']""
SET TIUY=0
GOTO CANPIX
+5 IF TIUTSTAT=13
SET TIUY=0
GOTO CANPIX
+6 IF TIUTSTAT=11
SET TIUY=1
GOTO CANPIX
+7 SET TIUPOWN=$PIECE(TIUT0,U,5)
SET TIUCOWN=+$PIECE(TIUT0,U,6)
+8 IF TIUTSTAT=10
SET TIUY=$SELECT(TIUPOWN=DUZ:1,+$$ISA^USRLM(DUZ,TIUCOWN):1,1:0)
CANPIX QUIT +$GET(TIUY)
REQCOSIG(TIUTYP,TIUDA,USER,TIUDT) ; Evaluate whether user requires cosignature
+1 NEW TIUI,TIUY,TIUDPRM
SET USER=$SELECT(+$GET(USER):+$GET(USER),1:+$GET(DUZ))
+2 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM,+$GET(TIUDA))
+3 IF $GET(TIUDPRM(5))=""
GOTO REQCOSX
+4 IF +$GET(TIUDT)'>0
SET TIUDT=+$PIECE($PIECE(+$GET(^TIU(8925,+$GET(TIUDA),13)),U),".")
+5 FOR TIUI=1:1:$LENGTH(TIUDPRM(5),U)
Begin DoDot:1
+6 SET TIUY=+$$ISA^USRLM(+USER,+$PIECE(TIUDPRM(5),U,TIUI),,+$GET(TIUDT))
End DoDot:1
IF +TIUY>0
QUIT
REQCOSX QUIT +$GET(TIUY)
+1 ;
REQCPF(TIUCDA) ;Check if clinical procedure fields are required
+1 ; Input -- TIUCDA Request/Consult File (#123) IEN
+2 ; Output -- 1=Required and 0=Not Required
+3 NEW TIUCPACT,REQF
+4 IF '$GET(TIUCDA)
GOTO REQCPFQ
+5 SET TIUCPACT=$$CPACTM^GMRCCP(TIUCDA)
+6 IF TIUCPACT=1!(TIUCPACT=3)
SET REQF=1
REQCPFQ QUIT +$GET(REQF)
