TIUADSIG ;SLC/JMH - Additional signature/surrogate methods ;10/13/04 [10/15/04 9:55am]
;;1.0;TEXT INTEGRATION UTILITIES;**157**;Jun 20, 1997
ASURG(TIUDA) ; checks if current user is a surrogate for an additional signer
; if so then it returns the 8925.7 record IEN
N TIUASDA,TIUY
S TIUASDA="",TIUY=0
F S TIUASDA=$O(^TIU(8925.7,"B",TIUDA,TIUASDA)) Q:'TIUASDA!(TIUY) D
. N TIUAS
. S TIUAS=$P($G(^TIU(8925.7,TIUASDA,0)),U,3)
. Q:'$G(TIUAS)
. I +$P($G(^TIU(8925.7,+TIUASDA,0)),U,4) Q
. I $$ISSURFOR(DUZ,TIUAS) S TIUY=TIUASDA
Q TIUY
ISSURFOR(USER1,USER2) ; check with kernel to see if USER1 is a surrogate for
; USER2
N ACTSUR ;actual surrogate
S ACTSUR=$$CURRSURO^XQALSURO(USER2)
I ACTSUR=USER1 Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUADSIG 736 printed Dec 13, 2024@02:38:47 Page 2
TIUADSIG ;SLC/JMH - Additional signature/surrogate methods ;10/13/04 [10/15/04 9:55am]
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**157**;Jun 20, 1997
ASURG(TIUDA) ; checks if current user is a surrogate for an additional signer
+1 ; if so then it returns the 8925.7 record IEN
+2 NEW TIUASDA,TIUY
+3 SET TIUASDA=""
SET TIUY=0
+4 FOR
SET TIUASDA=$ORDER(^TIU(8925.7,"B",TIUDA,TIUASDA))
if 'TIUASDA!(TIUY)
QUIT
Begin DoDot:1
+5 NEW TIUAS
+6 SET TIUAS=$PIECE($GET(^TIU(8925.7,TIUASDA,0)),U,3)
+7 if '$GET(TIUAS)
QUIT
+8 IF +$PIECE($GET(^TIU(8925.7,+TIUASDA,0)),U,4)
QUIT
+9 IF $$ISSURFOR(DUZ,TIUAS)
SET TIUY=TIUASDA
End DoDot:1
+10 QUIT TIUY
ISSURFOR(USER1,USER2) ; check with kernel to see if USER1 is a surrogate for
+1 ; USER2
+2 ;actual surrogate
NEW ACTSUR
+3 SET ACTSUR=$$CURRSURO^XQALSURO(USER2)
+4 IF ACTSUR=USER1
QUIT 1
+5 QUIT 0
