- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULP.m
r613 r623 1 TIULP ; SLC/JER - Functions determining privilege ;11/13/07 2 ;;1.0;TEXT INTEGRATION UTILITIES;**98,100,116,109,138,152,175,157,182,184,217,236,234**;Jun 20, 1997;Build 6 3 ; CANDO^USRLA: ICA 2325, ISA^USRLM: ICA 2324 4 ; 8930.1,2,8: IACS 3129,3128,3104 5 CANDO(TIUDA,TIUACT,PERSON) ; Can PERSON perform action now 6 ; Receives: TIUDA=Record number in file 8925 7 ; TIUACT=Name of user action in 8930.8 (USR ACTION) 8 ; PERSON=New Person file IFN. 9 ; Assumed to be DUZ if not received. 10 ; New **100** ID param, backward compatible. 11 ; Returns: TIUY=1:yes,0:no_"^"_why not message 12 N TIUI,TIUTYP,TIUROLE,STATUS,TIUY,TIUATYP,MSG,WHO,MODIFIER,TIUD0,TIUACTW 13 S TIUY=0 I '$G(PERSON) S PERSON=DUZ 14 S TIUD0=$G(^TIU(8925,+TIUDA,0)) I 'TIUD0 G CANDOX 15 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 16 S TIUACTW=$G(TIUACT) 17 ;**100** was I +TIUACT'>0 S TIUACT etc. 18 S TIUACT=$$USREVNT(TIUACT) I +TIUACT'>0 G CANDOX 19 ; -- Historical Procedures - Prohibit actions detailed in 20 ; HPCAN^TIUCP: P182 21 N HPCAN I $$ISHISTCP^TIUCP(+TIUD0) S HPCAN=$$HPCAN^TIUCP(+TIUACT) I 'HPCAN S TIUY=HPCAN G CANDOX 22 ; **152 Get status 23 S STATUS=+$P(TIUD0,U,5) 24 ; **152[234] prevents editing or sending back a completed or uncosigned document. 25 I STATUS>5,(+TIUACT=9)!(+TIUACT=17) D G CANDOX 26 . ; **152[234] Displays message to user 27 . I +TIUACT=9 S TIUY="0^ You may not edit uncosigned or completed documents." 28 . I +TIUACT=17 S TIUY="0^You may not send back uncosigned or completed documents." 29 ; -- In case business rules have changed, & children already existed: 30 I +TIUACT=24,$D(^TIU(8925,"GDAD",TIUDA)) D G CANDOX 31 . S TIUY="0^ This note cannot be attached; it has its own children." 32 I +TIUACT=25,+$G(^TIU(8925,TIUDA,21)) D G CANDOX 33 . S TIUY="0^ This note cannot receive interdisciplinary children; it is itself a child." 34 I +TIUACT=4!(+TIUACT=5),+$$BLANK^TIULC(TIUDA) D G CANDOX ;Sets TIUPRM1 35 . S TIUY="0^ Contains blanks ("_$P(TIUPRM1,U,6)_") which must be filled before "_$P(TIUACT,U,2)_"ATURE." 36 S TIUROLE=$$USRROLE(TIUDA,PERSON) 37 S TIUTYP=+TIUD0 38 I $$ISADDNDM^TIULC1(+TIUDA) S TIUATYP=TIUTYP,TIUTYP=+$G(^TIU(8925,+$P(TIUD0,U,6),0)) 39 I TIUROLE']"" S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,PERSON) 40 F TIUI=1:1:($L(TIUROLE,U)-1) D Q:+$G(TIUY)>0 41 . S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,PERSON,$P(TIUROLE,U,TIUI)) 42 I +$G(TIUATYP) S TIUTYP=+$G(TIUATYP) 43 ;**100** update for PERSON param; update for verb modifier: 44 I +TIUY'>0 D G CANDOX 45 . S WHO=" You" 46 . ;I PERSON'=DUZ S WHO=$P(^VA(200,PERSON,0),U),WHO=$$NAME^TIULS(WHO,"FIRST LAST") 47 . I PERSON'=DUZ S WHO=$$NAME^TIULS($$GET1^DIQ(200,PERSON,.01),"FIRST LAST") ;P182 48 . S MODIFIER=$P(TIUACT,U,3) I $L(MODIFIER) S MODIFIER=" "_MODIFIER 49 . ;e.g. "You may not ATTACH this UNSIGNED TELEPHONE NOTE TO AN ID NOTE." 50 . S MSG=WHO_" may not "_$P(TIUACT,U,2)_" this "_$P($G(^TIU(8925.6,+STATUS,0)),U)_" "_$$PNAME^TIULC1(TIUTYP)_MODIFIER_"." 51 . S TIUY=TIUY_U_MSG 52 I +TIUACT=15,$$HASIMG^TIURB2(+TIUDA) D G CANDOX 53 . S TIUY="0^ This document contains linked images. You must ""delete"" the Images using the Imaging package before proceeding." 54 ;VMP/ELR P217. Do not allow deletion of a parent with child 55 I $G(TIUACTW)["DELETE RECORD",$$HASIDKID^TIUGBR(+TIUDA) D G CANDOX 56 . S TIUY="0^ "_$$EZBLD^DIALOG(89250013) 57 CANDOX Q TIUY 58 ; 59 CANLINK(TIUTYP) ; Can user (DUZ) link (attach) a document of a particular type 60 ;to an ID note. 61 ; For use in ADD NEW ID NOTE, where docmt is not entered yet. 62 ; Assume most favorable circumstances (user will complete 63 ;the note, so if user still can't attach, can tell them no, 64 ;when they first select title for the new entry. 65 ; Rule out if TIUTYP can be an ID parent, since ID parent 66 ;and ID kid function as mutually exclusive, (regardless of 67 ;business rules). 68 N TIUACT,STATUS,USRROLE,TIUY 69 S TIUACT=$$USREVNT("ATTACH TO ID NOTE"),STATUS=7 ; complete 70 S USRROLE=+$O(^USR(8930.2,"B","COMPLETER",0)) 71 S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,DUZ,USRROLE) 72 I '$G(TIUY) S TIUY="0^ You may not use this title for interdisciplinary child entries." Q TIUY 73 ; -- If user can attach a certain note, but note can also receive 74 ; ID entries, don't let user attach it. -- 75 I $$POSSPRNT^TIULP(TIUTYP) S TIUY="0^ This interdisciplinary PARENT title cannot be used for CHILD entries." 76 ; -- If selected type is a CWAD, don't let user attach it: -- 77 I $$ISCWAD^TIULX(TIUTYP) S TIUY="0^ CWAD titles cannot be used for interdisciplinary entries." 78 ; -- If selected type is a PRF, don't let user attach it: -- 79 I $$ISPFTTL^TIUPRFL(TIUTYP) S TIUY="0^ Patient Record Flag titles cannot be used for interdisciplinary entries." 80 ; -- If selected type is a consult, don't let user attach it: -- 81 I $$ISA^TIULX(TIUTYP,+$$CLASS^TIUCNSLT) S TIUY="0^ Consult titles cannot be used for interdisciplinary entries." 82 Q TIUY 83 ; 84 POSSPRNT(TIUTYP) ; Is a docmt intended as a possible ID parent? 85 ;Returns 1^WHYCAN'TATTACH if there are business rules permitting ANYONE 86 ;to attach ID entries to notes of type TIUTYP. 87 ;Else returns 0. 88 N TIUACT,STATUS,TIUY,DADTYP 89 S TIUY=0,TIUACT=+$$USREVNT("ATTACH ID ENTRY") 90 F STATUS=6,7,8 D G:TIUY POSSX 91 . I $O(^USR(8930.1,"AR",TIUTYP,STATUS,TIUACT,0)) S TIUY=1 Q 92 . I $O(^USR(8930.1,"AC",TIUTYP,STATUS,TIUACT,0)) S TIUY=1 93 ; -- If no rules for TIUTYP, try its parent: -- 94 S DADTYP=$O(^TIU(8925.1,"AD",TIUTYP,0)) G:DADTYP'>0 POSSX 95 S TIUY=$$POSSPRNT(DADTYP) 96 POSSX I TIUY S TIUY="1^ Interdisciplinary PARENT notes cannot be attached as CHILD entries." 97 Q TIUY 98 ; 99 CANENTR(TIUTYP) ; Evaluate privilege to enter a document of a particular type 100 N TIUACT,STATUS,USRROLE,TIUY 101 S TIUACT=$$USREVNT("ENTRY"),STATUS=2 ; untranscribed 102 S USRROLE=3 ; transcriber 103 S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,DUZ,USRROLE) 104 Q TIUY 105 USRROLE(TIUDA,PERSON) ; Identify the user's role with respect to the document 106 ; 3/20/00 **100** Added role COMPLETER 107 ; 3/20/00 **100** Added PERSON param 108 N TIU0,TIU12,TIU13,TIUY,TIU15,COMPLTR,STATUS 109 S PERSON=$G(PERSON,DUZ) 110 S TIU0=$G(^TIU(8925,+TIUDA,0)),STATUS=$P(TIU0,U,5) 111 S TIU12=$G(^TIU(8925,+TIUDA,12)) 112 S TIU13=$G(^TIU(8925,+TIUDA,13)),TIU15=$G(^TIU(8925,+TIUDA,15)) 113 I PERSON=+$P(TIU13,U,2) S TIUY=+$O(^USR(8930.2,"B","TRANSCRIBER",0))_U 114 I PERSON=+$P(TIU12,U,2) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","AUTHOR/DICTATOR",0))_U 115 I PERSON=+$P(TIU12,U,9) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","ATTENDING PHYSICIAN",0))_U 116 I PERSON=+$P(TIU12,U,4) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","EXPECTED SIGNER",0))_U 117 I PERSON=+$P(TIU12,U,8) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","EXPECTED COSIGNER",0))_U 118 I $$ASURG^TIUADSIG(TIUDA) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","SURROGATE",0))_U ;P157 119 ;Check if the person can be an Interpreter for this document via a Consult API 120 I $$CPINTERP^GMRCCP(+TIUDA,PERSON) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","INTERPRETER",0))_U 121 I STATUS>6 D I COMPLTR S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","COMPLETER",0))_U 122 . S COMPLTR=0 123 . I PERSON=+$P(TIU15,U,8) S COMPLTR=1 Q 124 . I '$P(TIU15,U,8),PERSON=+$P(TIU15,U,2) S COMPLTR=1 125 I +$O(^TIU(8925.7,"AE",+TIUDA,+PERSON,0)) D 126 . N TIUXTRA S TIUXTRA=+$O(^TIU(8925.7,"AE",+TIUDA,+PERSON,0)) 127 . I +$P($G(^TIU(8925.7,+TIUXTRA,0)),U,4) Q 128 . S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","ADDITIONAL SIGNER",0))_U 129 Q $G(TIUY) 130 USREVNT(EVENT) ; Given event name, return: 131 ;EVENT = event pointer^user verb^verb modifier 132 ; **100** added verb modifier piece (.07) 133 N TIUY,TIUDA,NODE0 134 S TIUDA=+$O(^USR(8930.8,"B",EVENT,0)) 135 S NODE0=$G(^USR(8930.8,TIUDA,0)) 136 S TIUY=TIUDA_U_$P(NODE0,U,5)_U_$P(NODE0,U,7) 137 Q TIUY 138 CANPICK(TIUTYP) ; Screens selection of title by title status and 139 ;(for status TEST), by owner. 140 N TIUPOWN,TIUCOWN,TIUT0,TIUTSTAT,TIUY S TIUY=0 141 S TIUT0=$G(^TIU(8925.1,+TIUTYP,0)),TIUTSTAT=$P(TIUT0,U,7) 142 I TIUTSTAT']"" S TIUY=0 G CANPIX 143 I TIUTSTAT=13 S TIUY=0 G CANPIX 144 I TIUTSTAT=11 S TIUY=1 G CANPIX 145 S TIUPOWN=$P(TIUT0,U,5),TIUCOWN=+$P(TIUT0,U,6) 146 I TIUTSTAT=10 S TIUY=$S(TIUPOWN=DUZ:1,+$$ISA^USRLM(DUZ,TIUCOWN):1,1:0) 147 CANPIX Q +$G(TIUY) 148 REQCOSIG(TIUTYP,TIUDA,USER,TIUDT) ; Evaluate whether user requires cosignature 149 N TIUI,TIUY,TIUDPRM S USER=$S(+$G(USER):+$G(USER),1:+$G(DUZ)) 150 D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,+$G(TIUDA)) 151 I $G(TIUDPRM(5))="" G REQCOSX 152 I +$G(TIUDT)'>0 S TIUDT=+$P($P(+$G(^TIU(8925,+$G(TIUDA),13)),U),".") 153 F TIUI=1:1:$L(TIUDPRM(5),U) D Q:+TIUY>0 154 . S TIUY=+$$ISA^USRLM(+USER,+$P(TIUDPRM(5),U,TIUI),,+$G(TIUDT)) 155 REQCOSX Q +$G(TIUY) 156 ; 157 REQCPF(TIUCDA) ;Check if clinical procedure fields are required 158 ; Input -- TIUCDA Request/Consult File (#123) IEN 159 ; Output -- 1=Required and 0=Not Required 160 N TIUCPACT,REQF 161 I '$G(TIUCDA) G REQCPFQ 162 S TIUCPACT=$$CPACTM^GMRCCP(TIUCDA) 163 I TIUCPACT=1!(TIUCPACT=3) S REQF=1 164 REQCPFQ Q +$G(REQF) 1 TIULP ; SLC/JER - Functions determining privilege ;7/29/05 2 ;;1.0;TEXT INTEGRATION UTILITIES;**98,100,116,109,138,152,175,157,182,184,217**;Jun 20, 1997 3 CANDO(TIUDA,TIUACT,PERSON) ; Can PERSON perform action now 4 ; Receives: TIUDA=Record number in file 8925 5 ; TIUACT=Name of user action in 8930.8 (USR ACTION) 6 ; PERSON=New Person file IFN. 7 ; Assumed to be DUZ if not received. 8 ; New **100** ID param, backward compatible. 9 ; Returns: TIUY=1:yes,0:no_"^"_why not message 10 N TIUI,TIUTYP,TIUROLE,STATUS,TIUY,TIUATYP,MSG,WHO,MODIFIER,TIUD0,TIUACTW 11 S TIUY=0 I '$G(PERSON) S PERSON=DUZ 12 S TIUD0=$G(^TIU(8925,+TIUDA,0)) I 'TIUD0 G CANDOX 13 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 14 S TIUACTW=$G(TIUACT) 15 ;**100** was I +TIUACT'>0 S TIUACT etc. 16 S TIUACT=$$USREVNT(TIUACT) I +TIUACT'>0 G CANDOX 17 ; -- Historical Procedures - Prohibit actions detailed in 18 ; HPCAN^TIUCP: P182 19 N HPCAN I $$ISHISTCP^TIUCP(+TIUD0) S HPCAN=$$HPCAN^TIUCP(+TIUACT) I 'HPCAN S TIUY=HPCAN G CANDOX 20 ; **152 Get status to evaluate for completed document. 21 S STATUS=+$P(TIUD0,U,5) 22 ; **152 prevents editing or sending back a completed document. 23 I STATUS>6,(+TIUACT=9)!(+TIUACT=17) D G CANDOX 24 .; **152 Displays message to user 25 . I +TIUACT=9 S TIUY="0^ You may not edit a completed document." 26 . I +TIUACT=17 S TIUY="0^You may not send back this completed document." 27 ; -- In case business rules have changed, & children already existed: 28 I +TIUACT=24,$D(^TIU(8925,"GDAD",TIUDA)) D G CANDOX 29 . S TIUY="0^ This note cannot be attached; it has its own children." 30 I +TIUACT=25,+$G(^TIU(8925,TIUDA,21)) D G CANDOX 31 . S TIUY="0^ This note cannot receive interdisciplinary children; it is itself a child." 32 I +TIUACT=4!(+TIUACT=5),+$$BLANK^TIULC(TIUDA) D G CANDOX 33 . S TIUY="0^ Contains blanks ("_$P(TIUPRM1,U,6)_") which must be filled before "_$P(TIUACT,U,2)_"ATURE." 34 S TIUROLE=$$USRROLE(TIUDA,PERSON) 35 S TIUTYP=+TIUD0 36 I $$ISADDNDM^TIULC1(+TIUDA) S TIUATYP=TIUTYP,TIUTYP=+$G(^TIU(8925,+$P(TIUD0,U,6),0)) 37 I TIUROLE']"" S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,PERSON) 38 F TIUI=1:1:($L(TIUROLE,U)-1) D Q:+$G(TIUY)>0 39 . S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,PERSON,$P(TIUROLE,U,TIUI)) 40 I +$G(TIUATYP) S TIUTYP=+$G(TIUATYP) 41 ;**100** update for PERSON param; update for verb modifier: 42 I +TIUY'>0 D G CANDOX 43 . S WHO=" You" 44 . ;I PERSON'=DUZ S WHO=$P(^VA(200,PERSON,0),U),WHO=$$NAME^TIULS(WHO,"FIRST LAST") 45 . I PERSON'=DUZ S WHO=$$NAME^TIULS($$GET1^DIQ(200,PERSON,.01),"FIRST LAST") ;P182 46 . S MODIFIER=$P(TIUACT,U,3) I $L(MODIFIER) S MODIFIER=" "_MODIFIER 47 . ;e.g. "You may not ATTACH this UNSIGNED TELEPHONE NOTE TO AN ID NOTE." 48 . S MSG=WHO_" may not "_$P(TIUACT,U,2)_" this "_$P($G(^TIU(8925.6,+STATUS,0)),U)_" "_$$PNAME^TIULC1(TIUTYP)_MODIFIER_"." 49 . S TIUY=TIUY_U_MSG 50 I +TIUACT=15,$$HASIMG^TIURB2(+TIUDA) D G CANDOX 51 . S TIUY="0^ This document contains linked images. You must ""delete"" the Images using the Imaging package before proceeding." 52 ;VMP/ELR P217. Do not allow deletion of a parent with child 53 I $G(TIUACTW)["DELETE RECORD",$$HASIDKID^TIUGBR(+TIUDA) D G CANDOX 54 . S TIUY="0^ "_$$EZBLD^DIALOG(89250013) 55 CANDOX Q TIUY 56 ; 57 CANLINK(TIUTYP) ; Can user (DUZ) link (attach) a document of a particular type 58 ;to an ID note. 59 ; For use in ADD NEW ID NOTE, where docmt is not entered yet. 60 ; Assume most favorable circumstances (user will complete 61 ;the note, so if user still can't attach, can tell them no, 62 ;when they first select title for the new entry. 63 ; Rule out if TIUTYP can be an ID parent, since ID parent 64 ;and ID kid function as mutually exclusive, (regardless of 65 ;business rules). 66 N TIUACT,STATUS,USRROLE,TIUY 67 S TIUACT=$$USREVNT("ATTACH TO ID NOTE"),STATUS=7 ; complete 68 S USRROLE=+$O(^USR(8930.2,"B","COMPLETER",0)) 69 S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,DUZ,USRROLE) 70 I '$G(TIUY) S TIUY="0^ You may not use this title for interdisciplinary child entries." Q TIUY 71 ; -- If user can attach a certain note, but note can also receive 72 ; ID entries, don't let user attach it. -- 73 I $$POSSPRNT^TIULP(TIUTYP) S TIUY="0^ This interdisciplinary PARENT title cannot be used for CHILD entries." 74 ; -- If selected type is a CWAD, don't let user attach it: -- 75 I $$ISCWAD^TIULX(TIUTYP) S TIUY="0^ CWAD titles cannot be used for interdisciplinary entries." 76 ; -- If selected type is a PRF, don't let user attach it: -- 77 I $$ISPFTTL^TIUPRFL(TIUTYP) S TIUY="0^ Patient Record Flag titles cannot be used for interdisciplinary entries." 78 ; -- If selected type is a consult, don't let user attach it: -- 79 I $$ISA^TIULX(TIUTYP,+$$CLASS^TIUCNSLT) S TIUY="0^ Consult titles cannot be used for interdisciplinary entries." 80 Q TIUY 81 ; 82 POSSPRNT(TIUTYP) ; Is a docmt intended as a possible ID parent? 83 ;Returns 1^WHYCAN'TATTACH if there are business rules permitting ANYONE 84 ;to attach ID entries to notes of type TIUTYP. 85 ;Else returns 0. 86 N TIUACT,STATUS,TIUY,DADTYP 87 S TIUY=0,TIUACT=+$$USREVNT("ATTACH ID ENTRY") 88 F STATUS=6,7,8 D G:TIUY POSSX 89 . I $O(^USR(8930.1,"AR",TIUTYP,STATUS,TIUACT,0)) S TIUY=1 Q 90 . I $O(^USR(8930.1,"AC",TIUTYP,STATUS,TIUACT,0)) S TIUY=1 91 ; -- If no rules for TIUTYP, try its parent: -- 92 S DADTYP=$O(^TIU(8925.1,"AD",TIUTYP,0)) G:DADTYP'>0 POSSX 93 S TIUY=$$POSSPRNT(DADTYP) 94 POSSX I TIUY S TIUY="1^ Interdisciplinary PARENT notes cannot be attached as CHILD entries." 95 Q TIUY 96 ; 97 CANENTR(TIUTYP) ; Evaluate privilege to enter a document of a particular type 98 N TIUACT,STATUS,USRROLE,TIUY 99 S TIUACT=$$USREVNT("ENTRY"),STATUS=2 ; untranscribed 100 S USRROLE=3 ; transcriber 101 S TIUY=$$CANDO^USRLA(TIUTYP,STATUS,+TIUACT,DUZ,USRROLE) 102 Q TIUY 103 USRROLE(TIUDA,PERSON) ; Identify the user's role with respect to the document 104 ; 3/20/00 **100** Added role COMPLETER 105 ; 3/20/00 **100** Added PERSON param 106 N TIU0,TIU12,TIU13,TIUY,TIU15,COMPLTR,STATUS 107 S PERSON=$G(PERSON,DUZ) 108 S TIU0=$G(^TIU(8925,+TIUDA,0)),STATUS=$P(TIU0,U,5) 109 S TIU12=$G(^TIU(8925,+TIUDA,12)) 110 S TIU13=$G(^TIU(8925,+TIUDA,13)),TIU15=$G(^TIU(8925,+TIUDA,15)) 111 I PERSON=+$P(TIU13,U,2) S TIUY=+$O(^USR(8930.2,"B","TRANSCRIBER",0))_U 112 I PERSON=+$P(TIU12,U,2) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","AUTHOR/DICTATOR",0))_U 113 I PERSON=+$P(TIU12,U,9) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","ATTENDING PHYSICIAN",0))_U 114 I PERSON=+$P(TIU12,U,4) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","EXPECTED SIGNER",0))_U 115 I PERSON=+$P(TIU12,U,8) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","EXPECTED COSIGNER",0))_U 116 I $$ASURG^TIUADSIG(TIUDA) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","SURROGATE",0))_U ;P157 117 ;Check if the person can be an Interpreter for this document via a Consult API 118 I $$CPINTERP^GMRCCP(+TIUDA,PERSON) S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","INTERPRETER",0))_U 119 I STATUS>6 D I COMPLTR S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","COMPLETER",0))_U 120 . S COMPLTR=0 121 . I PERSON=+$P(TIU15,U,8) S COMPLTR=1 Q 122 . I '$P(TIU15,U,8),PERSON=+$P(TIU15,U,2) S COMPLTR=1 123 I +$O(^TIU(8925.7,"AE",+TIUDA,+PERSON,0)) D 124 . N TIUXTRA S TIUXTRA=+$O(^TIU(8925.7,"AE",+TIUDA,+PERSON,0)) 125 . I +$P($G(^TIU(8925.7,+TIUXTRA,0)),U,4) Q 126 . S TIUY=$G(TIUY)_+$O(^USR(8930.2,"B","ADDITIONAL SIGNER",0))_U 127 Q $G(TIUY) 128 USREVNT(EVENT) ; Given event name, return: 129 ;EVENT = event pointer^user verb^verb modifier 130 ; **100** added verb modifier piece (.07) 131 N TIUY,TIUDA,NODE0 132 S TIUDA=+$O(^USR(8930.8,"B",EVENT,0)) 133 S NODE0=$G(^USR(8930.8,TIUDA,0)) 134 S TIUY=TIUDA_U_$P(NODE0,U,5)_U_$P(NODE0,U,7) 135 Q TIUY 136 CANPICK(TIUTYP) ; Screens selection of title by title status and 137 ;(for status TEST), by owner. 138 N TIUPOWN,TIUCOWN,TIUT0,TIUTSTAT,TIUY S TIUY=0 139 S TIUT0=$G(^TIU(8925.1,+TIUTYP,0)),TIUTSTAT=$P(TIUT0,U,7) 140 I TIUTSTAT']"" S TIUY=0 G CANPIX 141 I TIUTSTAT=13 S TIUY=0 G CANPIX 142 I TIUTSTAT=11 S TIUY=1 G CANPIX 143 S TIUPOWN=$P(TIUT0,U,5),TIUCOWN=+$P(TIUT0,U,6) 144 I TIUTSTAT=10 S TIUY=$S(TIUPOWN=DUZ:1,+$$ISA^USRLM(DUZ,TIUCOWN):1,1:0) 145 CANPIX Q +$G(TIUY) 146 REQCOSIG(TIUTYP,TIUDA,USER,TIUDT) ; Evaluate whether user requires cosignature 147 N TIUI,TIUY,TIUDPRM S USER=$S(+$G(USER):+$G(USER),1:+$G(DUZ)) 148 D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,+$G(TIUDA)) 149 I $G(TIUDPRM(5))="" G REQCOSX 150 I +$G(TIUDT)'>0 S TIUDT=+$P($P(+$G(^TIU(8925,+$G(TIUDA),13)),U),".") 151 F TIUI=1:1:$L(TIUDPRM(5),U) D Q:+TIUY>0 152 . S TIUY=+$$ISA^USRLM(+USER,+$P(TIUDPRM(5),U,TIUI),,+$G(TIUDT)) 153 REQCOSX Q +$G(TIUY) 154 ; 155 REQCPF(TIUCDA) ;Check if clinical procedure fields are required 156 ; Input -- TIUCDA Request/Consult File (#123) IEN 157 ; Output -- 1=Required and 0=Not Required 158 N TIUCPACT,REQF 159 I '$G(TIUCDA) G REQCPFQ 160 S TIUCPACT=$$CPACTM^GMRCCP(TIUCDA) 161 I TIUCPACT=1!(TIUCPACT=3) S REQF=1 162 REQCPFQ Q +$G(REQF)
Note:
See TracChangeset
for help on using the changeset viewer.
