SROXPR ;B'HAM ISC/MAM - RESTRICTED PERSON FIELDS ; 26 DEC 1991 9:15 AM
;;3.0; Surgery ;;24 Jun 93
KEY ; determine whether field is restricted
K SROK I +Y<1 Q
I $O(^SRP("AX",RESTRICT,0))="" S SROK=1 Q
S KEY=0 F S KEY=$O(^SRP("AX",RESTRICT,KEY)) Q:KEY=""!($D(SROK)) I $D(^XUSEC(KEY,Y)) S SROK=1
END K RESTRICT,ENTRY,KEY
Q
XREF ; set logic for 'AX' cross reference in file 131
S SRENTRY=$P(^SRP(DA(1),0),"^"),^SRP("AX",SRENTRY,X,DA(1))="" K ENTRY
Q
KXREF ; kill logic for 'AX' cross reference in file 131
S SRENTRY=$P(^SRP(DA(1),0),"^") K ^SRP("AX",SRENTRY,X,DA(1)),SRENTRY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROXPR 599 printed Nov 22, 2024@17:56:43 Page 2
SROXPR ;B'HAM ISC/MAM - RESTRICTED PERSON FIELDS ; 26 DEC 1991 9:15 AM
+1 ;;3.0; Surgery ;;24 Jun 93
KEY ; determine whether field is restricted
+1 KILL SROK
IF +Y<1
QUIT
+2 IF $ORDER(^SRP("AX",RESTRICT,0))=""
SET SROK=1
QUIT
+3 SET KEY=0
FOR
SET KEY=$ORDER(^SRP("AX",RESTRICT,KEY))
if KEY=""!($DATA(SROK))
QUIT
IF $DATA(^XUSEC(KEY,Y))
SET SROK=1
END KILL RESTRICT,ENTRY,KEY
+1 QUIT
XREF ; set logic for 'AX' cross reference in file 131
+1 SET SRENTRY=$PIECE(^SRP(DA(1),0),"^")
SET ^SRP("AX",SRENTRY,X,DA(1))=""
KILL ENTRY
+2 QUIT
KXREF ; kill logic for 'AX' cross reference in file 131
+1 SET SRENTRY=$PIECE(^SRP(DA(1),0),"^")
KILL ^SRP("AX",SRENTRY,X,DA(1)),SRENTRY
+2 QUIT
