- 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 Jan 18, 2025@03:47:55 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