SROFLD.m

SROFLD ;B'HAM ISC/MAM - GET FILE & FIELD FOR KEY RESTRICTION ; 10 DEC 1992  11:45 AM

 ;;3.0; Surgery ;;24 Jun 93

 S SRSOUT=0 K DIC,DA,DO S DIC=1,DIC(0)="QEAMZ",DIC("A")="Select File: " D ^DIC K DIC I Y<0 S SRSOUT=1 G END

 S SRFILE=Y,DI=+Y,N=0 D DI^DIU I Y<0 S SRSOUT=1 G END

 S SRFILE=DI,SRFIELD=+Y,SRENTRY=DI_","_SRFIELD

 I '$O(^SRP("B",SRENTRY,0)) D ADD G END

 S SRP=$O(^SRP("B",SRENTRY,0))

 Q

END D ^SRSKILL W @IOF

 Q

ADD ; add entry in PERSON FIELD RESTRICTION file

 W !!,"This field does not exist in the PERSON FIELD RESTRICTION file.  Do you",!,"want to add it ?  YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N",SRSOUT=1 Q

 S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter RETURN or 'YES' to add this entry to the file so that restrictions may",!,"be applied, or 'NO' to quit this option." G ADD

 I "Yy"'[SRYN S SRSOUT=1 Q

 K DIC,DD,DINUM,DO,DA S DIC="^SRP(",DIC(0)="L",DLAYGO=131,X=SRENTRY D FILE^DICN S SRP=+Y

 W ! K DIE,DA,DR S DA=SRP,DIE=131,DR="5T;3T" D ^DIE K DR,DA

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROFLD   994     printed  Dec 13, 2024@02:43:46                                                                                                                                                                                                       Page 2

SROFLD    ;B'HAM ISC/MAM - GET FILE & FIELD FOR KEY RESTRICTION ; 10 DEC 1992  11:45 AM

 +1       ;;3.0; Surgery ;;24 Jun 93

 +2        SET SRSOUT=0

           KILL DIC,DA,DO

           SET DIC=1

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Select File: "

           DO ^DIC

           KILL DIC

           IF Y<0

               SET SRSOUT=1

               GOTO END

 +3        SET SRFILE=Y

           SET DI=+Y

           SET N=0

           DO DI^DIU

           IF Y<0

               SET SRSOUT=1

               GOTO END

 +4        SET SRFILE=DI

           SET SRFIELD=+Y

           SET SRENTRY=DI_","_SRFIELD

 +5        IF '$ORDER(^SRP("B",SRENTRY,0))

               DO ADD

               GOTO END

 +6        SET SRP=$ORDER(^SRP("B",SRENTRY,0))

 +7        QUIT 

END        DO ^SRSKILL

           WRITE @IOF

 +1        QUIT 

ADD       ; add entry in PERSON FIELD RESTRICTION file

 +1        WRITE !!,"This field does not exist in the PERSON FIELD RESTRICTION file.  Do you",!,"want to add it ?  YES// "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRYN="N"

               SET SRSOUT=1

               QUIT 

 +2        SET SRYN=$EXTRACT(SRYN)

           IF "YyNn"'[SRYN

               WRITE !!,"Enter RETURN or 'YES' to add this entry to the file so that restrictions may",!,"be applied, or 'NO' to quit this option."

               GOTO ADD

 +3        IF "Yy"'[SRYN

               SET SRSOUT=1

               QUIT 

 +4        KILL DIC,DD,DINUM,DO,DA

           SET DIC="^SRP("

           SET DIC(0)="L"

           SET DLAYGO=131

           SET X=SRENTRY

           DO FILE^DICN

           SET SRP=+Y

 +5        WRITE !

           KILL DIE,DA,DR

           SET DA=SRP

           SET DIE=131

           SET DR="5T;3T"

           DO ^DIE

           KILL DR,DA

 +6        QUIT