TIUSRVA ; SLC/JER,AJB - API'S FOR AUTHORIZATION ;11/02/23 11:00
;;1.0;TEXT INTEGRATION UTILITIES;**19,28,47,80,100,116,152,160,178,175,157,236,234,239,268,289,355,357**;Jun 20, 1997;Build 5
;
; Reference to $$GET1^DIQ supported by ICR #2056
; Reference to $$PATCH^XPDUTL supported by ICR #10141
; Reference to FIELD^DID supported by ICR #2052
; Reference to File ^AUPNVSIT supported by ICR #3580
; Reference to $$ISA^USRLM supported by ICR #1544
; Reference to $$ACTVSURO^XQALSURO supported by ICR #2790
;
Q
REQCOS(TIUY,TIUTYP,TIUDA,TIUSER,TIUDT) ; Evaluate cosignature requirement
; Initialize return value
N TIUDPRM
S TIUY=0
I +$G(TIUTYP)'>0,'+$G(TIUDA) Q
I +$G(TIUDA) S TIUTYP=+$G(^TIU(8925,+$G(TIUDA),0))
S:'+$G(TIUSER) TIUSER=+$G(DUZ)
; VMP/RJT --- *239 - Make sure only date is being passed into REQCOSIG and not date/time
S TIUY=+$$REQCOSIG^TIULP(TIUTYP,+$G(TIUDA),+$G(TIUSER),$P(+$G(TIUDT),"."))
Q
URGENCY(TIUY) ; -- retrieve set values from dd for discharge summary urgency
N TIUDD,TIUI,TIUX
D FIELD^DID(8925,.09,"","POINTER","TIUDD")
F TIUI=1:1 S TIUX=$P(TIUDD("POINTER"),";",TIUI) Q:TIUX="" S TIUY(TIUI)=$TR(TIUX,":","^")
Q
CANDO(TIUY,TIUDA,TIUACT) ; Boolean function to evaluate privilege
N TIUPOP,TIUDPRM S TIUPOP=0
; **152** prevent editing completed [uncosigned] documents.
I $P($G(^TIU(8925,TIUDA,0)),U,5)>5,(TIUACT="EDIT RECORD") S TIUY="0^ You may not edit uncosigned or completed documents" Q
I $S(TIUACT["SIGN":1,TIUACT="EDIT RECORD":1,TIUACT="DELETE RECORD":1,1:0) D Q:+TIUPOP=1
. L +^TIU(8925,+TIUDA):1
. E S TIUY="0^ Another session is editing this entry.",TIUPOP=1
. L -^TIU(8925,+TIUDA)
;VMP/ELR *239 -- CHANGED TIUACT["SIGN" TO TIUACT["SIGNAT" - WAS EXECUTING LINE FOR INDENTIFYING SIGNERS
I TIUACT["SIGNAT",+$$NEEDCS(TIUDA) S TIUY="0^ You must name a cosigner before signing this document." Q
S TIUY=$$CANDO^TIULP(TIUDA,TIUACT)
Q
NEEDCS(TIUDA) ; Does user need a cosigner?
N TIUD0,TIUD12,TIUY,SIGNER,COSIGNER,XTRASGNR
S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^(12))
S SIGNER=$P(TIUD12,U,4),COSIGNER=$P(TIUD12,U,8),XTRASGNR=0
I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
;VMP/DJH *268 no cosigner needed if surrogate for additional signer
I '+XTRASGNR S XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
I +XTRASGNR S TIUY=0
E I +$$REQCOSIG^TIULP(+TIUD0,TIUDA,DUZ),(+$P(TIUD12,U,8)'>0) S TIUY=1
Q +$G(TIUY)
USRINACT(TIUY,TIUDA) ; Is user inactive?
S TIUY=+$$GET1^DIQ(200,TIUDA_",",7,"I")
Q
AUTHSIGN(TIUY,TIUDA,TIUUSR) ; Has Author signed?
; if TIUY =
; 0 = Author has NOT signed & TIUUSR = Expected Cosigner
; 1 = Author HAS signed or TIUUSR '= Expected Cosigner
;
N TIUD12,TIUD15
S TIUD12=$G(^TIU(8925,TIUDA,12)),TIUD15=$G(^(15))
S TIUY=1
D:$P(TIUD12,U,8)=TIUUSR Q
. S:$P(TIUD12,U,2)'=$P(TIUD15,U,2) TIUY=0
Q
TIUVISIT(TIUY,DOCTYP,DFN,VISIT) ; Check for a 1 time only doc
; TIUY = return value
; = 0 if can add more than one or none already exist
; = 1 if cannot add more than one and one already exists
; DOCTYP = Pointer to ^TIU(8925.1, TIU DOCUMENT DEFINITION
; DFN = Patient IEN
; VISIT = Visit String "LOC;VDATE;VTYP"
; *289 ajb
I $$PATCH^XPDUTL("OR*3.0*195") D Q
. S TIUY=0 ; default is allow
. Q:($G(DOCTYP)="")!($G(DFN)="")!($G(VISIT)="")
. N TIUDPRM D DOCPRM^TIULC1(DOCTYP,.TIUDPRM) ; get document parameters
. I $P(TIUDPRM(0),U,10)=""!($P(TIUDPRM(0),U,10)=1) Q ; no value or ALLOW >1 RECORD PER VISIT is YES
. I $L(VISIT,";")=3 D
. . N TIUDA I $$EXIST^TIUEDI3(DFN,DOCTYP,VISIT) S TIUY=1 Q ; document exists
. . N TIUDS S TIUDS=$$FIND1^DIC(8925.1,"","","DISCHARGE SUMMARY","","I $P(^(0),U,4)=""CL""","")
. . I '+TIUDS!('$$ISA^TIULX(DOCTYP,TIUDS)) Q ; can't find class or not a child of DISCHARGE SUMMARY, quit
. . N IEN,NAME S (NAME,TIUDA)="" F S NAME=$O(^TIU(8925.1,"ACL",TIUDS,NAME)) Q:NAME="" D Q:+TIUDA
. . . S IEN="" F S IEN=$O(^TIU(8925.1,"ACL",TIUDS,NAME,IEN)) Q:'+IEN S TIUDA=$$EXIST^TIUEDI3(DFN,IEN,VISIT) Q:+TIUDA
. . I +TIUDA S TIUY=1
; /*289
I '$$PATCH^XPDUTL("OR*3.0*195") D
. Q:($G(DOCTYP)="")!($G(DFN)="")!($G(VISIT)="")
. N TIUX3
. S TIUX3=+$O(^TIU(8925.95,"B",DOCTYP,""))
. S TIUY=$P($G(^TIU(8925.95,TIUX3,0)),U,10) S TIUY=$S(TIUY=0:1,1:0)
. Q:'TIUY
. S VISIT=((9999999-$P(VISIT,"."))_"."_$P(VISIT,".",2))
. S VISIT=+$O(^AUPNVSIT("AA",DFN,VISIT,""))
. S TIUY=$S($D(^TIU(8925,"AV",DFN,DOCTYP,VISIT)):0,1:1)
. S TIUY=$S(TIUY=0:1,1:0)
Q
WHATACT(TIUY,TIUDA) ; Evaluate/return whether signature or cosignature
N TIUD0,TIUD12,TIUSTAT,SIGNER,COSIGNER,XTRASGNR
S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
S SIGNER=$P(TIUD12,U,4),COSIGNER=$P(TIUD12,U,8)
I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
I '$G(XTRASGNR) S XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
S TIUSTAT=+$P(TIUD0,U,5)
S TIUY=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
Q
CANCHCOS(TIUY,TIUDA) ; Evaluate/return whether user can change cosigner
S TIUY=$$MAYCHNG^TIURA1(TIUDA)
Q
NEEDJUST(TIUY,TIUDA) ; Is justification required for deletion?
N TIUD0 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUY=0
I +$P(TIUD0,U,5)'<6 S TIUY=1
Q
GETTITLE(TIUY,TIUDA) ; Get the title from a TIU Document Record
S TIUY=+$G(^TIU(8925,+TIUDA,0))
Q
CANATTCH(TIUY,TIUDA) ; Can this document be attached as an ID Child
N TITLEDA,PARENTDA
S TITLEDA=+$G(^TIU(8925,TIUDA,0))
I TITLEDA'>0 S TIUY="0^Document #"_TIUDA_" does not exist." Q
S PARENTDA=+$G(^TIU(8925,TIUDA,21))
S TIUY=$$POSSPRNT^TIULP(TITLEDA)
I +TIUY S TIUY="-1"_U_$P(TIUY,U,2) Q
I +$$ISCWAD^TIULX(TITLEDA) D Q
. S TIUY="0^ CWAD Documents may not be Attached as Interdisciplinary Entries."
I +$$ISA^TIULX(TITLEDA,+$$CLASS^TIUCNSLT) D Q
. S TIUY="0^ Consult Results may not be Attached as Interdisciplinary Entries."
S TIUY=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
I PARENTDA D ; action must be "detach"
. I 'TIUY S TIUY="0^ You may not detach this note from an interdisciplinary note." Q
. S TIUY=$$CANDO^TIULP(PARENTDA,"ATTACH ID ENTRY")
. I 'TIUY S TIUY="0^ You may not detach this note from its interdisciplinary note."
Q
CANRCV(TIUY,TIUDA) ; Can this document receive an ID Child?
S TIUY=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
Q
WORKCHRT(TIUY,TIUDA) ; RPC: Can user print Work or Chart copy of document
; TIUDA=IEN of docmt
;Returns TIUY:
;TIUY = 0^message Can't print at all (fails bus rules)
;TIUY = 1 Can print work copy only
;TIUY = 2 Can print work or chart copy (Param=1 or user is MAS)
N CANPRNT,TIUDTYP,TIUDPRM
S CANPRNT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
I 'CANPRNT S TIUY=CANPRNT Q
S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
D DOCPRM^TIULC1(TIUDTYP,.TIUDPRM,TIUDA)
I +$P(TIUDPRM(0),U,9) S TIUY=2 Q
I +$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION") S TIUY=2 Q
S TIUY=1
Q
NDTOSIGN(TIUY,TIUDA) ; current user need to sign this document? *355 ajb
N NODE,STATUS S NODE(0)=$G(^TIU(8925,+TIUDA,0)),NODE(12)=$G(^TIU(8925,+TIUDA,12)),STATUS=$P(NODE(0),U,5),TIUY=0
I STATUS'<6 D ; uncosigned/completed/amended notes
. I STATUS=6 D Q:+TIUY ; uncosigned notes
. . I DUZ=$P(NODE(12),U,8) S TIUY=1 Q ; is user the expected cosigner?
. . I +$P(NODE(12),U,8) I DUZ=$$ACTVSURO^XQALSURO($P(NODE(12),U,8)) S TIUY=1 Q ; is user a surrogate for cosigner?
. N IEN S IEN=0 F S IEN=$O(^TIU(8925.7,"AC",+NODE(12),+TIUDA,IEN)) Q:'+IEN D Q:+TIUY
. . N ADDSIGNER S ADDSIGNER=$P($G(^TIU(8925.7,IEN,0)),U,3) Q:'ADDSIGNER
. . I DUZ=ADDSIGNER S TIUY=1 Q ; is user the additional signer?
. . I DUZ=$$ACTVSURO^XQALSURO(ADDSIGNER) S TIUY=1 ; is user a surrogate for the additional signer?
I STATUS'>5 D ; unsigned notes - check signer/cosigner
. I DUZ=$P(NODE(12),U,4)!(DUZ=$P(NODE(12),U,8)) S TIUY=1 Q ; is user the expected signer or expected cosigner?
. I +$P(NODE(12),U,4) I DUZ=$$ACTVSURO^XQALSURO($P(NODE(12),U,4)) S TIUY=1 Q ; is user a surrogate for expected signer?
. I +$P(NODE(12),U,8) I DUZ=$$ACTVSURO^XQALSURO($P(NODE(12),U,8)) S TIUY=1 ; is user a surrogate for expected cosigner?
I STATUS'<6,'TIUY D TASKALRT^TIUALRT(TIUDA) ; resend alert(s) *357
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVA 8236 printed Apr 09, 2024@21:41:12 Page 2
TIUSRVA ; SLC/JER,AJB - API'S FOR AUTHORIZATION ;11/02/23 11:00
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**19,28,47,80,100,116,152,160,178,175,157,236,234,239,268,289,355,357**;Jun 20, 1997;Build 5
+2 ;
+3 ; Reference to $$GET1^DIQ supported by ICR #2056
+4 ; Reference to $$PATCH^XPDUTL supported by ICR #10141
+5 ; Reference to FIELD^DID supported by ICR #2052
+6 ; Reference to File ^AUPNVSIT supported by ICR #3580
+7 ; Reference to $$ISA^USRLM supported by ICR #1544
+8 ; Reference to $$ACTVSURO^XQALSURO supported by ICR #2790
+9 ;
+10 QUIT
REQCOS(TIUY,TIUTYP,TIUDA,TIUSER,TIUDT) ; Evaluate cosignature requirement
+1 ; Initialize return value
+2 NEW TIUDPRM
+3 SET TIUY=0
+4 IF +$GET(TIUTYP)'>0
IF '+$GET(TIUDA)
QUIT
+5 IF +$GET(TIUDA)
SET TIUTYP=+$GET(^TIU(8925,+$GET(TIUDA),0))
+6 if '+$GET(TIUSER)
SET TIUSER=+$GET(DUZ)
+7 ; VMP/RJT --- *239 - Make sure only date is being passed into REQCOSIG and not date/time
+8 SET TIUY=+$$REQCOSIG^TIULP(TIUTYP,+$GET(TIUDA),+$GET(TIUSER),$PIECE(+$GET(TIUDT),"."))
+9 QUIT
URGENCY(TIUY) ; -- retrieve set values from dd for discharge summary urgency
+1 NEW TIUDD,TIUI,TIUX
+2 DO FIELD^DID(8925,.09,"","POINTER","TIUDD")
+3 FOR TIUI=1:1
SET TIUX=$PIECE(TIUDD("POINTER"),";",TIUI)
if TIUX=""
QUIT
SET TIUY(TIUI)=$TRANSLATE(TIUX,":","^")
+4 QUIT
CANDO(TIUY,TIUDA,TIUACT) ; Boolean function to evaluate privilege
+1 NEW TIUPOP,TIUDPRM
SET TIUPOP=0
+2 ; **152** prevent editing completed [uncosigned] documents.
+3 IF $PIECE($GET(^TIU(8925,TIUDA,0)),U,5)>5
IF (TIUACT="EDIT RECORD")
SET TIUY="0^ You may not edit uncosigned or completed documents"
QUIT
+4 IF $SELECT(TIUACT["SIGN":1,TIUACT="EDIT RECORD":1,TIUACT="DELETE RECORD":1,1:0)
Begin DoDot:1
+5 LOCK +^TIU(8925,+TIUDA):1
+6 IF '$TEST
SET TIUY="0^ Another session is editing this entry."
SET TIUPOP=1
+7 LOCK -^TIU(8925,+TIUDA)
End DoDot:1
if +TIUPOP=1
QUIT
+8 ;VMP/ELR *239 -- CHANGED TIUACT["SIGN" TO TIUACT["SIGNAT" - WAS EXECUTING LINE FOR INDENTIFYING SIGNERS
+9 IF TIUACT["SIGNAT"
IF +$$NEEDCS(TIUDA)
SET TIUY="0^ You must name a cosigner before signing this document."
QUIT
+10 SET TIUY=$$CANDO^TIULP(TIUDA,TIUACT)
+11 QUIT
NEEDCS(TIUDA) ; Does user need a cosigner?
+1 NEW TIUD0,TIUD12,TIUY,SIGNER,COSIGNER,XTRASGNR
+2 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET TIUD12=$GET(^(12))
+3 SET SIGNER=$PIECE(TIUD12,U,4)
SET COSIGNER=$PIECE(TIUD12,U,8)
SET XTRASGNR=0
+4 IF (DUZ'=SIGNER)
IF (DUZ'=COSIGNER)
SET XTRASGNR=+$ORDER(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
+5 ;VMP/DJH *268 no cosigner needed if surrogate for additional signer
+6 IF '+XTRASGNR
SET XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
+7 IF +XTRASGNR
SET TIUY=0
+8 IF '$TEST
IF +$$REQCOSIG^TIULP(+TIUD0,TIUDA,DUZ)
IF (+$PIECE(TIUD12,U,8)'>0)
SET TIUY=1
+9 QUIT +$GET(TIUY)
USRINACT(TIUY,TIUDA) ; Is user inactive?
+1 SET TIUY=+$$GET1^DIQ(200,TIUDA_",",7,"I")
+2 QUIT
AUTHSIGN(TIUY,TIUDA,TIUUSR) ; Has Author signed?
+1 ; if TIUY =
+2 ; 0 = Author has NOT signed & TIUUSR = Expected Cosigner
+3 ; 1 = Author HAS signed or TIUUSR '= Expected Cosigner
+4 ;
+5 NEW TIUD12,TIUD15
+6 SET TIUD12=$GET(^TIU(8925,TIUDA,12))
SET TIUD15=$GET(^(15))
+7 SET TIUY=1
+8 if $PIECE(TIUD12,U,8)=TIUUSR
Begin DoDot:1
+9 if $PIECE(TIUD12,U,2)'=$PIECE(TIUD15,U,2)
SET TIUY=0
End DoDot:1
QUIT
+10 QUIT
TIUVISIT(TIUY,DOCTYP,DFN,VISIT) ; Check for a 1 time only doc
+1 ; TIUY = return value
+2 ; = 0 if can add more than one or none already exist
+3 ; = 1 if cannot add more than one and one already exists
+4 ; DOCTYP = Pointer to ^TIU(8925.1, TIU DOCUMENT DEFINITION
+5 ; DFN = Patient IEN
+6 ; VISIT = Visit String "LOC;VDATE;VTYP"
+7 ; *289 ajb
+8 IF $$PATCH^XPDUTL("OR*3.0*195")
Begin DoDot:1
+9 ; default is allow
SET TIUY=0
+10 if ($GET(DOCTYP)="")!($GET(DFN)="")!($GET(VISIT)="")
QUIT
+11 ; get document parameters
NEW TIUDPRM
DO DOCPRM^TIULC1(DOCTYP,.TIUDPRM)
+12 ; no value or ALLOW >1 RECORD PER VISIT is YES
IF $PIECE(TIUDPRM(0),U,10)=""!($PIECE(TIUDPRM(0),U,10)=1)
QUIT
+13 IF $LENGTH(VISIT,";")=3
Begin DoDot:2
+14 ; document exists
NEW TIUDA
IF $$EXIST^TIUEDI3(DFN,DOCTYP,VISIT)
SET TIUY=1
QUIT
+15 NEW TIUDS
SET TIUDS=$$FIND1^DIC(8925.1,"","","DISCHARGE SUMMARY","","I $P(^(0),U,4)=""CL""","")
+16 ; can't find class or not a child of DISCHARGE SUMMARY, quit
IF '+TIUDS!('$$ISA^TIULX(DOCTYP,TIUDS))
QUIT
+17 NEW IEN,NAME
SET (NAME,TIUDA)=""
FOR
SET NAME=$ORDER(^TIU(8925.1,"ACL",TIUDS,NAME))
if NAME=""
QUIT
Begin DoDot:3
+18 SET IEN=""
FOR
SET IEN=$ORDER(^TIU(8925.1,"ACL",TIUDS,NAME,IEN))
if '+IEN
QUIT
SET TIUDA=$$EXIST^TIUEDI3(DFN,IEN,VISIT)
if +TIUDA
QUIT
End DoDot:3
if +TIUDA
QUIT
+19 IF +TIUDA
SET TIUY=1
End DoDot:2
End DoDot:1
QUIT
+20 ; /*289
+21 IF '$$PATCH^XPDUTL("OR*3.0*195")
Begin DoDot:1
+22 if ($GET(DOCTYP)="")!($GET(DFN)="")!($GET(VISIT)="")
QUIT
+23 NEW TIUX3
+24 SET TIUX3=+$ORDER(^TIU(8925.95,"B",DOCTYP,""))
+25 SET TIUY=$PIECE($GET(^TIU(8925.95,TIUX3,0)),U,10)
SET TIUY=$SELECT(TIUY=0:1,1:0)
+26 if 'TIUY
QUIT
+27 SET VISIT=((9999999-$PIECE(VISIT,"."))_"."_$PIECE(VISIT,".",2))
+28 SET VISIT=+$ORDER(^AUPNVSIT("AA",DFN,VISIT,""))
+29 SET TIUY=$SELECT($DATA(^TIU(8925,"AV",DFN,DOCTYP,VISIT)):0,1:1)
+30 SET TIUY=$SELECT(TIUY=0:1,1:0)
End DoDot:1
+31 QUIT
WHATACT(TIUY,TIUDA) ; Evaluate/return whether signature or cosignature
+1 NEW TIUD0,TIUD12,TIUSTAT,SIGNER,COSIGNER,XTRASGNR
+2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
SET TIUD12=$GET(^TIU(8925,+TIUDA,12))
+3 SET SIGNER=$PIECE(TIUD12,U,4)
SET COSIGNER=$PIECE(TIUD12,U,8)
+4 IF (DUZ'=SIGNER)
IF (DUZ'=COSIGNER)
SET XTRASGNR=+$ORDER(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
+5 IF '$GET(XTRASGNR)
SET XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
+6 SET TIUSTAT=+$PIECE(TIUD0,U,5)
+7 SET TIUY=$SELECT(TIUSTAT'>5:"SIGNATURE",+$GET(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
+8 QUIT
CANCHCOS(TIUY,TIUDA) ; Evaluate/return whether user can change cosigner
+1 SET TIUY=$$MAYCHNG^TIURA1(TIUDA)
+2 QUIT
NEEDJUST(TIUY,TIUDA) ; Is justification required for deletion?
+1 NEW TIUD0
SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
SET TIUY=0
+2 IF +$PIECE(TIUD0,U,5)'<6
SET TIUY=1
+3 QUIT
GETTITLE(TIUY,TIUDA) ; Get the title from a TIU Document Record
+1 SET TIUY=+$GET(^TIU(8925,+TIUDA,0))
+2 QUIT
CANATTCH(TIUY,TIUDA) ; Can this document be attached as an ID Child
+1 NEW TITLEDA,PARENTDA
+2 SET TITLEDA=+$GET(^TIU(8925,TIUDA,0))
+3 IF TITLEDA'>0
SET TIUY="0^Document #"_TIUDA_" does not exist."
QUIT
+4 SET PARENTDA=+$GET(^TIU(8925,TIUDA,21))
+5 SET TIUY=$$POSSPRNT^TIULP(TITLEDA)
+6 IF +TIUY
SET TIUY="-1"_U_$PIECE(TIUY,U,2)
QUIT
+7 IF +$$ISCWAD^TIULX(TITLEDA)
Begin DoDot:1
+8 SET TIUY="0^ CWAD Documents may not be Attached as Interdisciplinary Entries."
End DoDot:1
QUIT
+9 IF +$$ISA^TIULX(TITLEDA,+$$CLASS^TIUCNSLT)
Begin DoDot:1
+10 SET TIUY="0^ Consult Results may not be Attached as Interdisciplinary Entries."
End DoDot:1
QUIT
+11 SET TIUY=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
+12 ; action must be "detach"
IF PARENTDA
Begin DoDot:1
+13 IF 'TIUY
SET TIUY="0^ You may not detach this note from an interdisciplinary note."
QUIT
+14 SET TIUY=$$CANDO^TIULP(PARENTDA,"ATTACH ID ENTRY")
+15 IF 'TIUY
SET TIUY="0^ You may not detach this note from its interdisciplinary note."
End DoDot:1
+16 QUIT
CANRCV(TIUY,TIUDA) ; Can this document receive an ID Child?
+1 SET TIUY=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
+2 QUIT
WORKCHRT(TIUY,TIUDA) ; RPC: Can user print Work or Chart copy of document
+1 ; TIUDA=IEN of docmt
+2 ;Returns TIUY:
+3 ;TIUY = 0^message Can't print at all (fails bus rules)
+4 ;TIUY = 1 Can print work copy only
+5 ;TIUY = 2 Can print work or chart copy (Param=1 or user is MAS)
+6 NEW CANPRNT,TIUDTYP,TIUDPRM
+7 SET CANPRNT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
+8 IF 'CANPRNT
SET TIUY=CANPRNT
QUIT
+9 SET TIUDTYP=+$GET(^TIU(8925,TIUDA,0))
+10 DO DOCPRM^TIULC1(TIUDTYP,.TIUDPRM,TIUDA)
+11 IF +$PIECE(TIUDPRM(0),U,9)
SET TIUY=2
QUIT
+12 IF +$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")
SET TIUY=2
QUIT
+13 SET TIUY=1
+14 QUIT
NDTOSIGN(TIUY,TIUDA) ; current user need to sign this document? *355 ajb
+1 NEW NODE,STATUS
SET NODE(0)=$GET(^TIU(8925,+TIUDA,0))
SET NODE(12)=$GET(^TIU(8925,+TIUDA,12))
SET STATUS=$PIECE(NODE(0),U,5)
SET TIUY=0
+2 ; uncosigned/completed/amended notes
IF STATUS'<6
Begin DoDot:1
+3 ; uncosigned notes
IF STATUS=6
Begin DoDot:2
+4 ; is user the expected cosigner?
IF DUZ=$PIECE(NODE(12),U,8)
SET TIUY=1
QUIT
+5 ; is user a surrogate for cosigner?
IF +$PIECE(NODE(12),U,8)
IF DUZ=$$ACTVSURO^XQALSURO($PIECE(NODE(12),U,8))
SET TIUY=1
QUIT
End DoDot:2
if +TIUY
QUIT
+6 NEW IEN
SET IEN=0
FOR
SET IEN=$ORDER(^TIU(8925.7,"AC",+NODE(12),+TIUDA,IEN))
if '+IEN
QUIT
Begin DoDot:2
+7 NEW ADDSIGNER
SET ADDSIGNER=$PIECE($GET(^TIU(8925.7,IEN,0)),U,3)
if 'ADDSIGNER
QUIT
+8 ; is user the additional signer?
IF DUZ=ADDSIGNER
SET TIUY=1
QUIT
+9 ; is user a surrogate for the additional signer?
IF DUZ=$$ACTVSURO^XQALSURO(ADDSIGNER)
SET TIUY=1
End DoDot:2
if +TIUY
QUIT
End DoDot:1
+10 ; unsigned notes - check signer/cosigner
IF STATUS'>5
Begin DoDot:1
+11 ; is user the expected signer or expected cosigner?
IF DUZ=$PIECE(NODE(12),U,4)!(DUZ=$PIECE(NODE(12),U,8))
SET TIUY=1
QUIT
+12 ; is user a surrogate for expected signer?
IF +$PIECE(NODE(12),U,4)
IF DUZ=$$ACTVSURO^XQALSURO($PIECE(NODE(12),U,4))
SET TIUY=1
QUIT
+13 ; is user a surrogate for expected cosigner?
IF +$PIECE(NODE(12),U,8)
IF DUZ=$$ACTVSURO^XQALSURO($PIECE(NODE(12),U,8))
SET TIUY=1
End DoDot:1
+14 ; resend alert(s) *357
IF STATUS'<6
IF 'TIUY
DO TASKALRT^TIUALRT(TIUDA)
+15 QUIT
