SROKEY.m

SROKEY ;B'HAM ISC/MAM - UPDATE KEYS RESTRICTING ENTRIES ; 9 JAN 1992

 ;;3.0; Surgery ;;24 Jun 93

 W @IOF,!,"Add 'PERSON' Field Restrictions: ",! 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))

EXIST ; edit existing entry

 I '$O(^SRP(SRP,1,0)) S ^SRP(SRP,1,0)="^131.03^^"

 I $O(^SRP(SRP,1,0)) W !!,"Keys Currently used to Restrict Entries: "

 I '$O(^SRP(SRP,1,0)) W !!,"There are no keys restricting entries in this field."

 S (CNT,KEY)=0 F  S KEY=$O(^SRP(SRP,1,KEY)) Q:'KEY  S CNT=CNT+1,SRKEY(CNT)=$P(^SRP(SRP,1,KEY,0),"^")_"^"_KEY W:CNT=1 ! W !,?2,CNT_".",?5,$P(SRKEY(CNT),"^")

ANOTHER W !!,"Do you want to add a key ?  YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END

 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"

 I "YyNn"'[SRYN W !!,"Enter 'YES' or RETURN to enter a key which will be used to restrict",!,"access to this field, or 'NO' if no additional keys are required." G ANOTHER

 I "Yy"[SRYN W ! S CNT=0,Y=1 F  Q:Y<0  K DIC S DIC=19.1,DIC(0)="QEAMZ",DIC("A")="Select Additional Key: " D ^DIC I Y>0 S CNT=CNT+1,ADDKEY(CNT)=$P(Y,"^",2)

 I $D(ADDKEY(1)) W !!,"Entering Keys..."

 S CNT=0 F  S CNT=$O(ADDKEY(CNT)) Q:'CNT  K DA,DD,DO,DIC S DA(1)=SRP,DLAYGO=130.03,DIC(0)="L",DIC="^SRP("_SRP_",1,",X=ADDKEY(CNT) D FILE^DICN K DLAYGO,DIC

END D ^SRSKILL W @IOF

 Q

RET W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1

 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

SROKEY    ;B'HAM ISC/MAM - UPDATE KEYS RESTRICTING ENTRIES ; 9 JAN 1992

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

 +2        WRITE @IOF,!,"Add 'PERSON' Field Restrictions: ",!

           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))

EXIST     ; edit existing entry

 +1        IF '$ORDER(^SRP(SRP,1,0))

               SET ^SRP(SRP,1,0)="^131.03^^"

 +2        IF $ORDER(^SRP(SRP,1,0))

               WRITE !!,"Keys Currently used to Restrict Entries: "

 +3        IF '$ORDER(^SRP(SRP,1,0))

               WRITE !!,"There are no keys restricting entries in this field."

 +4        SET (CNT,KEY)=0

           FOR 

               SET KEY=$ORDER(^SRP(SRP,1,KEY))

               IF 'KEY

                   QUIT 

               SET CNT=CNT+1

               SET SRKEY(CNT)=$PIECE(^SRP(SRP,1,KEY,0),"^")_"^"_KEY

               IF CNT=1

                   WRITE !

               WRITE !,?2,CNT_".",?5,$PIECE(SRKEY(CNT),"^")

ANOTHER    WRITE !!,"Do you want to add a key ?  YES// "

           READ SRYN:DTIME

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

               SET SRSOUT=1

               GOTO END

 +1        SET SRYN=$EXTRACT(SRYN)

           IF SRYN=""

               SET SRYN="Y"

 +2        IF "YyNn"'[SRYN

               WRITE !!,"Enter 'YES' or RETURN to enter a key which will be used to restrict",!,"access to this field, or 'NO' if no additional keys are required."

               GOTO ANOTHER

 +3        IF "Yy"[SRYN

               WRITE !

               SET CNT=0

               SET Y=1

               FOR 

                   IF Y<0

                       QUIT 

                   KILL DIC

                   SET DIC=19.1

                   SET DIC(0)="QEAMZ"

                   SET DIC("A")="Select Additional Key: "

                   DO ^DIC

                   IF Y>0

                       SET CNT=CNT+1

                       SET ADDKEY(CNT)=$PIECE(Y,"^",2)

 +4        IF $DATA(ADDKEY(1))

               WRITE !!,"Entering Keys..."

 +5        SET CNT=0

           FOR 

               SET CNT=$ORDER(ADDKEY(CNT))

               IF 'CNT

                   QUIT 

               KILL DA,DD,DO,DIC

               SET DA(1)=SRP

               SET DLAYGO=130.03

               SET DIC(0)="L"

               SET DIC="^SRP("_SRP_",1,"

               SET X=ADDKEY(CNT)

               DO FILE^DICN

               KILL DLAYGO,DIC

END        DO ^SRSKILL

           WRITE @IOF

 +1        QUIT 

RET        WRITE !!,"Press RETURN to continue, or '^' to quit: "

           READ X:DTIME

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

               SET SRSOUT=1

 +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