Index: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVA.m
===================================================================
--- WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVA.m	(revision 613)
+++ WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVA.m	(revision 623)
@@ -1,118 +1,118 @@
-TIUSRVA	; SLC/JER,AJB - API's for Authorization ; 11/13/07
-	;;1.0;TEXT INTEGRATION UTILITIES;**19,28,47,80,100,116,152,160,178,175,157,236,234**;Jun 20, 1997;Build 6
-	;
-	;External reference to File ^AUPNVSIT supported by DBIA 3580
-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)
-	S TIUY=+$$REQCOSIG^TIULP(TIUTYP,+$G(TIUDA),+$G(TIUSER),+$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)
-	I TIUACT["SIGN",+$$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))
-	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 ^TUI(8925.1,   TIU DOCUMENT DEFINITION
-	;  DFN     =    Patient IEN
-	;  VISIT   =    Visit String "LOC;VDATE;VTYP"
-	I $$PATCH^XPDUTL("OR*3.0*195") D
-	. Q:($G(DOCTYP)="")!($G(DFN)="")!($G(VISIT)="")
-	. N TIUDPRM,TIUTEST
-	. D DOCPRM^TIULC1(DOCTYP,.TIUDPRM)
-	. S TIUY=$S($P(TIUDPRM(0),U,10)="":1,1:$P(TIUDPRM(0),U,10))
-	. I TIUY=1 S TIUY=0 Q
-	. I $L(VISIT,";")=3 D
-	. . S TIUTEST=$$EXIST^TIUEDI3(DFN,DOCTYP,VISIT)
-	. . I TIUTEST S TIUY=1
-	. . I 'TIUTEST S TIUY=0
-	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
+TIUSRVA ; SLC/JER,AJB - API's for Authorization ; 03/18/04 [10/19/04 1:21pm]
+ ;;1.0;TEXT INTEGRATION UTILITIES;**19,28,47,80,100,116,152,160,178,175,157**;Jun 20, 1997
+ ;
+ ;External reference to File ^AUPNVSIT supported by DBIA 3580
+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)
+ S TIUY=+$$REQCOSIG^TIULP(TIUTYP,+$G(TIUDA),+$G(TIUSER),+$G(TIUDT))
+ Q
+URGENCY(Y) ; -- retrieve set values from dd for discharge summary urgency
+ N TIUDD,I,X
+ D FIELD^DID(8925,.09,"","POINTER","TIUDD")
+ F I=1:1 S X=$P(TIUDD("POINTER"),";",I) Q:X=""   S Y(I)=$TR(X,":","^")
+ Q
+CANDO(Y,TIUDA,TIUACT) ; Boolean function to evaluate privilege
+ N TIUPOP,TIUDPRM S TIUPOP=0
+ ; **152** code added to prevent editing a completed document.
+ I $P($G(^TIU(8925,TIUDA,0)),U,5)>6,(TIUACT="EDIT RECORD") S Y="0^ You may not edit a completed document" 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 Y="0^ Another session is editing this entry.",TIUPOP=1
+ . L -^TIU(8925,+TIUDA)
+ I TIUACT["SIGN",+$$NEEDCS(TIUDA) S Y="0^ You must name a cosigner before signing this document." Q
+ S Y=$$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))
+ 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 ^TUI(8925.1,   TIU DOCUMENT DEFINITION
+ ;  DFN     =    Patient IEN
+ ;  VISIT   =    Visit String "LOC;VDATE;VTYP"
+ I $$PATCH^XPDUTL("OR*3.0*195") D
+ . Q:($G(DOCTYP)="")!($G(DFN)="")!($G(VISIT)="")
+ . N TIUDPRM,TIUTEST
+ . D DOCPRM^TIULC1(DOCTYP,.TIUDPRM)
+ . S TIUY=$S($P(TIUDPRM(0),U,10)="":1,1:$P(TIUDPRM(0),U,10))
+ . I TIUY=1 S TIUY=0 Q
+ . I $L(VISIT,";")=3 D
+ . . S TIUTEST=$$EXIST^TIUEDI3(DFN,DOCTYP,VISIT)
+ . . I TIUTEST S TIUY=1
+ . . I 'TIUTEST S TIUY=0
+ I '$$PATCH^XPDUTL("OR*3.0*195") D
+ . Q:($G(DOCTYP)="")!($G(DFN)="")!($G(VISIT)="")
+ . N X3
+ . S X3=+$O(^TIU(8925.95,"B",DOCTYP,""))
+ . S TIUY=$P($G(^TIU(8925.95,X3,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(Y,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 Y=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
+ Q
+CANCHCOS(Y,TIUDA) ; Evaluate/return whether user can change cosigner
+ S Y=$$MAYCHNG^TIURA1(TIUDA)
+ Q
+NEEDJUST(Y,TIUDA) ; Is justification required for deletion?
+ N TIUD0 S TIUD0=$G(^TIU(8925,+TIUDA,0)),Y=0
+ I +$P(TIUD0,U,5)'<6 S Y=1
+ Q
+GETTITLE(Y,TIUDA) ; Get the title from a TIU Document Record
+ S Y=+$G(^TIU(8925,+TIUDA,0))
+ Q
+CANATTCH(Y,TIUDA) ; Can this document be attached as an ID Child
+ N TITLEDA,PARENTDA
+ S TITLEDA=+$G(^TIU(8925,TIUDA,0))
+ I TITLEDA'>0 S Y="0^Document #"_TIUDA_" does not exist." Q
+ S PARENTDA=+$G(^TIU(8925,TIUDA,21))
+ S Y=$$POSSPRNT^TIULP(TITLEDA)
+ I +Y S Y="-1"_U_$P(Y,U,2) Q
+ I +$$ISCWAD^TIULX(TITLEDA) D  Q
+ . S Y="0^ CWAD Documents may not be Attached as Interdisciplinary Entries."
+ I +$$ISA^TIULX(TITLEDA,+$$CLASS^TIUCNSLT) D  Q
+ . S Y="0^ Consult Results may not be Attached as Interdisciplinary Entries."
+ S Y=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
+ I PARENTDA D  ; action must be "detach"
+ . I 'Y S Y="0^ You may not detach this note from an interdisciplinary note." Q
+ . S Y=$$CANDO^TIULP(PARENTDA,"ATTACH ID ENTRY")
+ . I 'Y S Y="0^ You may not detach this note from its interdisciplinary note."
+ Q
+CANRCV(Y,TIUDA) ; Can this document receive an ID Child?
+ S Y=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
+ Q
