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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROKEY 2167 printed Dec 13, 2024@02:44 Page 2
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
