- 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/TIUSRVA.m
r613 r623 1 TIUSRVA ; SLC/JER,AJB - API's for Authorization ; 11/13/072 ;;1.0;TEXT INTEGRATION UTILITIES;**19,28,47,80,100,116,152,160,178,175,157,236,234**;Jun 20, 1997;Build 6 3 4 5 REQCOS(TIUY,TIUTYP,TIUDA,TIUSER,TIUDT) 6 7 8 9 10 11 12 13 14 URGENCY( TIUY); -- retrieve set values from dd for discharge summary urgency15 N TIUDD,TIUI,TIUX16 17 F TIUI=1:1 S TIUX=$P(TIUDD("POINTER"),";",TIUI) Q:TIUX="" S TIUY(TIUI)=$TR(TIUX,":","^")18 19 CANDO( TIUY,TIUDA,TIUACT); Boolean function to evaluate privilege20 21 ; **152** prevent editing completed [uncosigned] documents.22 I $P($G(^TIU(8925,TIUDA,0)),U,5)>5,(TIUACT="EDIT RECORD") S TIUY="0^ You may not edit uncosigned or completed documents" Q23 24 25 . E S TIUY="0^ Another session is editing this entry.",TIUPOP=126 27 I TIUACT["SIGN",+$$NEEDCS(TIUDA) S TIUY="0^ You must name a cosigner before signing this document." Q28 S TIUY=$$CANDO^TIULP(TIUDA,TIUACT)29 30 NEEDCS(TIUDA) 31 32 33 34 35 36 37 38 USRINACT(TIUY,TIUDA) 39 40 41 AUTHSIGN(TIUY,TIUDA,TIUUSR) 42 43 44 45 46 47 48 49 50 51 52 TIUVISIT(TIUY,DOCTYP,DFN,VISIT) 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 . N TIUX372 . S TIUX3=+$O(^TIU(8925.95,"B",DOCTYP,""))73 . S TIUY=$P($G(^TIU(8925.95,TIUX3,0)),U,10) S TIUY=$S(TIUY=0:1,1:0)74 75 76 77 78 79 80 WHATACT( TIUY,TIUDA); Evaluate/return whether signature or cosignature81 82 83 84 85 86 87 S TIUY=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")88 89 CANCHCOS( TIUY,TIUDA); Evaluate/return whether user can change cosigner90 S TIUY=$$MAYCHNG^TIURA1(TIUDA)91 92 NEEDJUST( TIUY,TIUDA); Is justification required for deletion?93 N TIUD0 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUY=094 I +$P(TIUD0,U,5)'<6 S TIUY=195 96 GETTITLE( TIUY,TIUDA); Get the title from a TIU Document Record97 S TIUY=+$G(^TIU(8925,+TIUDA,0))98 99 CANATTCH( TIUY,TIUDA); Can this document be attached as an ID Child100 101 102 I TITLEDA'>0 S TIUY="0^Document #"_TIUDA_" does not exist." Q103 104 S TIUY=$$POSSPRNT^TIULP(TITLEDA)105 I +TIUY S TIUY="-1"_U_$P(TIUY,U,2) Q106 107 . S TIUY="0^ CWAD Documents may not be Attached as Interdisciplinary Entries."108 109 . S TIUY="0^ Consult Results may not be Attached as Interdisciplinary Entries."110 S TIUY=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")111 112 . I 'TIUY S TIUY="0^ You may not detach this note from an interdisciplinary note." Q113 . S TIUY=$$CANDO^TIULP(PARENTDA,"ATTACH ID ENTRY")114 . I 'TIUY S TIUY="0^ You may not detach this note from its interdisciplinary note."115 116 CANRCV( TIUY,TIUDA); Can this document receive an ID Child?117 S TIUY=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")118 1 TIUSRVA ; 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 5 REQCOS(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 14 URGENCY(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 19 CANDO(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 30 NEEDCS(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) 38 USRINACT(TIUY,TIUDA) ; Is user inactive? 39 S TIUY=+$$GET1^DIQ(200,TIUDA_",",7,"I") 40 Q 41 AUTHSIGN(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 52 TIUVISIT(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 80 WHATACT(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 89 CANCHCOS(Y,TIUDA) ; Evaluate/return whether user can change cosigner 90 S Y=$$MAYCHNG^TIURA1(TIUDA) 91 Q 92 NEEDJUST(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 96 GETTITLE(Y,TIUDA) ; Get the title from a TIU Document Record 97 S Y=+$G(^TIU(8925,+TIUDA,0)) 98 Q 99 CANATTCH(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 116 CANRCV(Y,TIUDA) ; Can this document receive an ID Child? 117 S Y=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY") 118 Q
Note:
See TracChangeset
for help on using the changeset viewer.
