Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUSRVA

TIUSRVA.m

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