source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVA.m@ 1608

Last change on this file since 1608 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 4.9 KB
Line 
1TIUSRVA ; SLC/JER,AJB - API's for Authorization ; 03/18/04 [10/19/04 1:21pm]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**19,28,47,80,100,116,152,160,178,175,157**;Jun 20, 1997
3 ;
4 ;External reference to File ^AUPNVSIT supported by DBIA 3580
5REQCOS(TIUY,TIUTYP,TIUDA,TIUSER,TIUDT) ; Evaluate cosignature requirement
6 ; Initialize return value
7 N TIUDPRM
8 S TIUY=0
9 I +$G(TIUTYP)'>0,'+$G(TIUDA) Q
10 I +$G(TIUDA) S TIUTYP=+$G(^TIU(8925,+$G(TIUDA),0))
11 S:'+$G(TIUSER) TIUSER=+$G(DUZ)
12 S TIUY=+$$REQCOSIG^TIULP(TIUTYP,+$G(TIUDA),+$G(TIUSER),+$G(TIUDT))
13 Q
14URGENCY(Y) ; -- retrieve set values from dd for discharge summary urgency
15 N TIUDD,I,X
16 D FIELD^DID(8925,.09,"","POINTER","TIUDD")
17 F I=1:1 S X=$P(TIUDD("POINTER"),";",I) Q:X="" S Y(I)=$TR(X,":","^")
18 Q
19CANDO(Y,TIUDA,TIUACT) ; Boolean function to evaluate privilege
20 N TIUPOP,TIUDPRM S TIUPOP=0
21 ; **152** code added to prevent editing a completed document.
22 I $P($G(^TIU(8925,TIUDA,0)),U,5)>6,(TIUACT="EDIT RECORD") S Y="0^ You may not edit a completed document" Q
23 I $S(TIUACT["SIGN":1,TIUACT="EDIT RECORD":1,TIUACT="DELETE RECORD":1,1:0) D Q:+TIUPOP=1
24 . L +^TIU(8925,+TIUDA):1
25 . E S Y="0^ Another session is editing this entry.",TIUPOP=1
26 . L -^TIU(8925,+TIUDA)
27 I TIUACT["SIGN",+$$NEEDCS(TIUDA) S Y="0^ You must name a cosigner before signing this document." Q
28 S Y=$$CANDO^TIULP(TIUDA,TIUACT)
29 Q
30NEEDCS(TIUDA) ; Does user need a cosigner?
31 N TIUD0,TIUD12,TIUY,SIGNER,COSIGNER,XTRASGNR
32 S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^(12))
33 S SIGNER=$P(TIUD12,U,4),COSIGNER=$P(TIUD12,U,8),XTRASGNR=0
34 I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
35 I +XTRASGNR S TIUY=0
36 E I +$$REQCOSIG^TIULP(+TIUD0,TIUDA,DUZ),(+$P(TIUD12,U,8)'>0) S TIUY=1
37 Q +$G(TIUY)
38USRINACT(TIUY,TIUDA) ; Is user inactive?
39 S TIUY=+$$GET1^DIQ(200,TIUDA_",",7,"I")
40 Q
41AUTHSIGN(TIUY,TIUDA,TIUUSR) ; Has Author signed?
42 ; if TIUY =
43 ; 0 = Author has NOT signed & TIUUSR = Expected Cosigner
44 ; 1 = Author HAS signed or TIUUSR '= Expected Cosigner
45 ;
46 N TIUD12,TIUD15
47 S TIUD12=$G(^TIU(8925,TIUDA,12)),TIUD15=$G(^(15))
48 S TIUY=1
49 D:$P(TIUD12,U,8)=TIUUSR Q
50 . S:$P(TIUD12,U,2)'=$P(TIUD15,U,2) TIUY=0
51 Q
52TIUVISIT(TIUY,DOCTYP,DFN,VISIT) ; Check for a 1 time only doc
53 ; TIUY = return value
54 ; = 0 if can add more than one or none already exist
55 ; = 1 if cannot add more than one and one already exists
56 ; DOCTYP = Pointer to ^TUI(8925.1, TIU DOCUMENT DEFINITION
57 ; DFN = Patient IEN
58 ; VISIT = Visit String "LOC;VDATE;VTYP"
59 I $$PATCH^XPDUTL("OR*3.0*195") D
60 . Q:($G(DOCTYP)="")!($G(DFN)="")!($G(VISIT)="")
61 . N TIUDPRM,TIUTEST
62 . D DOCPRM^TIULC1(DOCTYP,.TIUDPRM)
63 . S TIUY=$S($P(TIUDPRM(0),U,10)="":1,1:$P(TIUDPRM(0),U,10))
64 . I TIUY=1 S TIUY=0 Q
65 . I $L(VISIT,";")=3 D
66 . . S TIUTEST=$$EXIST^TIUEDI3(DFN,DOCTYP,VISIT)
67 . . I TIUTEST S TIUY=1
68 . . I 'TIUTEST S TIUY=0
69 I '$$PATCH^XPDUTL("OR*3.0*195") D
70 . Q:($G(DOCTYP)="")!($G(DFN)="")!($G(VISIT)="")
71 . N X3
72 . S X3=+$O(^TIU(8925.95,"B",DOCTYP,""))
73 . S TIUY=$P($G(^TIU(8925.95,X3,0)),U,10) S TIUY=$S(TIUY=0:1,1:0)
74 . Q:'TIUY
75 . S VISIT=((9999999-$P(VISIT,"."))_"."_$P(VISIT,".",2))
76 . S VISIT=+$O(^AUPNVSIT("AA",DFN,VISIT,""))
77 . S TIUY=$S($D(^TIU(8925,"AV",DFN,DOCTYP,VISIT)):0,1:1)
78 . S TIUY=$S(TIUY=0:1,1:0)
79 Q
80WHATACT(Y,TIUDA) ; Evaluate/return whether signature or cosignature
81 N TIUD0,TIUD12,TIUSTAT,SIGNER,COSIGNER,XTRASGNR
82 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
83 S SIGNER=$P(TIUD12,U,4),COSIGNER=$P(TIUD12,U,8)
84 I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
85 I '$G(XTRASGNR) S XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
86 S TIUSTAT=+$P(TIUD0,U,5)
87 S Y=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
88 Q
89CANCHCOS(Y,TIUDA) ; Evaluate/return whether user can change cosigner
90 S Y=$$MAYCHNG^TIURA1(TIUDA)
91 Q
92NEEDJUST(Y,TIUDA) ; Is justification required for deletion?
93 N TIUD0 S TIUD0=$G(^TIU(8925,+TIUDA,0)),Y=0
94 I +$P(TIUD0,U,5)'<6 S Y=1
95 Q
96GETTITLE(Y,TIUDA) ; Get the title from a TIU Document Record
97 S Y=+$G(^TIU(8925,+TIUDA,0))
98 Q
99CANATTCH(Y,TIUDA) ; Can this document be attached as an ID Child
100 N TITLEDA,PARENTDA
101 S TITLEDA=+$G(^TIU(8925,TIUDA,0))
102 I TITLEDA'>0 S Y="0^Document #"_TIUDA_" does not exist." Q
103 S PARENTDA=+$G(^TIU(8925,TIUDA,21))
104 S Y=$$POSSPRNT^TIULP(TITLEDA)
105 I +Y S Y="-1"_U_$P(Y,U,2) Q
106 I +$$ISCWAD^TIULX(TITLEDA) D Q
107 . S Y="0^ CWAD Documents may not be Attached as Interdisciplinary Entries."
108 I +$$ISA^TIULX(TITLEDA,+$$CLASS^TIUCNSLT) D Q
109 . S Y="0^ Consult Results may not be Attached as Interdisciplinary Entries."
110 S Y=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
111 I PARENTDA D ; action must be "detach"
112 . I 'Y S Y="0^ You may not detach this note from an interdisciplinary note." Q
113 . S Y=$$CANDO^TIULP(PARENTDA,"ATTACH ID ENTRY")
114 . I 'Y S Y="0^ You may not detach this note from its interdisciplinary note."
115 Q
116CANRCV(Y,TIUDA) ; Can this document receive an ID Child?
117 S Y=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
118 Q
Note: See TracBrowser for help on using the repository browser.