SROXPR.m

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

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