- 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 Jan 18, 2025@03:46:51 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