- 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 Feb 19, 2025@00:05:15 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