SROKEY1 ;B'HAM ISC/MAM - REMOVE KEY RESTRICTIONS ; 9 JAN 1992
;;3.0; Surgery ;;24 Jun 93
W @IOF,!,"Remove '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)) W !!,"There are no restrictions currently applied to this field.",!!,"Press RETURN to continue " R X:DTIME G END
S SRP=$O(^SRP("B",SRENTRY,0))
I '$O(^SRP(SRP,1,0)) W !!,"There are no keys restricting entries in this field.",!!,"Press RETURN to continue " R X:DTIME G END
W @IOF,!,"Current Restrictions for 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 !,?2,CNT_".",?5,$P(SRKEY(CNT),"^")
I '$D(SRKEY(2)) S NUMBER=1 D ONE G END
REMOVE W !!,"Do you want to remove one of these keys ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N" Q
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
I "YyNn"'[SRYN W !!,"Enter 'YES' if you want to remove one of the keys currently used to restrict",!,"entries in this field. Enter 'NO' if you do not want to remove any existing",!,"keys." D RET G:SRSOUT END G REMOVE
S FLAG=0 I "Yy"[SRYN D TAKEY G:SRSOUT END S FLAG=1
END D ^SRSKILL W @IOF
Q
TAKEY ; remove security keys
W !!,"Select Number or 'ALL': " R NUMBER:DTIME I '$T!("^"[NUMBER) S SRSOUT=1 Q
I '$D(SRKEY(NUMBER)),NUMBER'="ALL" W !!,"Select the number corresponding to the key you want to remove, or enter 'ALL'",!,"to remove all keys." G TAKEY
I NUMBER="ALL" W !!,"Removing all restrictions..." H 2 S NUMBER=0 F S NUMBER=$O(SRKEY(NUMBER)) Q:'NUMBER D DIK
I '$O(SRKEY(0)) Q
DIK S DA=$P(SRKEY(NUMBER),"^",2),DA(1)=SRP,DIK="^SRP("_SRP_",1," D ^DIK K DA,DIK,SRKEY(NUMBER)
Q
RET W !!,"Press RETURN to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1
Q
ONE ; only one key
W !!,"Do you want to remove the "_$P(SRKEY(1),"^")_" key ? YES// " R SRYN:DTIME I '$T!(SRYN["^") Q
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
I "YyNn"'[SRYN W !!,"Enter 'YES' to remove this key, eliminating all restrictions on this field, or",!,"'NO' to leave the restriction in place." G ONE
I "Yy"[SRYN S NUMBER=1 D DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROKEY1 2284 printed Dec 13, 2024@02:44:01 Page 2
SROKEY1 ;B'HAM ISC/MAM - REMOVE KEY RESTRICTIONS ; 9 JAN 1992
+1 ;;3.0; Surgery ;;24 Jun 93
+2 WRITE @IOF,!,"Remove '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))
WRITE !!,"There are no restrictions currently applied to this field.",!!,"Press RETURN to continue "
READ X:DTIME
GOTO END
+6 SET SRP=$ORDER(^SRP("B",SRENTRY,0))
+7 IF '$ORDER(^SRP(SRP,1,0))
WRITE !!,"There are no keys restricting entries in this field.",!!,"Press RETURN to continue "
READ X:DTIME
GOTO END
+8 WRITE @IOF,!,"Current Restrictions for this Field: ",!
+9 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
WRITE !,?2,CNT_".",?5,$PIECE(SRKEY(CNT),"^")
+10 IF '$DATA(SRKEY(2))
SET NUMBER=1
DO ONE
GOTO END
REMOVE WRITE !!,"Do you want to remove one of these keys ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRYN="N"
QUIT
+1 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
+2 IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' if you want to remove one of the keys currently used to restrict",!,"entries in this field. Enter 'NO' if you do not want to remove any existing",!,"keys."
DO RET
if SRSOUT
GOTO END
GOTO REMOVE
+3 SET FLAG=0
IF "Yy"[SRYN
DO TAKEY
if SRSOUT
GOTO END
SET FLAG=1
END DO ^SRSKILL
WRITE @IOF
+1 QUIT
TAKEY ; remove security keys
+1 WRITE !!,"Select Number or 'ALL': "
READ NUMBER:DTIME
IF '$TEST!("^"[NUMBER)
SET SRSOUT=1
QUIT
+2 IF '$DATA(SRKEY(NUMBER))
IF NUMBER'="ALL"
WRITE !!,"Select the number corresponding to the key you want to remove, or enter 'ALL'",!,"to remove all keys."
GOTO TAKEY
+3 IF NUMBER="ALL"
WRITE !!,"Removing all restrictions..."
HANG 2
SET NUMBER=0
FOR
SET NUMBER=$ORDER(SRKEY(NUMBER))
if 'NUMBER
QUIT
DO DIK
+4 IF '$ORDER(SRKEY(0))
QUIT
DIK SET DA=$PIECE(SRKEY(NUMBER),"^",2)
SET DA(1)=SRP
SET DIK="^SRP("_SRP_",1,"
DO ^DIK
KILL DA,DIK,SRKEY(NUMBER)
+1 QUIT
RET WRITE !!,"Press RETURN to continue, or '^' to quit "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
+1 QUIT
ONE ; only one key
+1 WRITE !!,"Do you want to remove the "_$PIECE(SRKEY(1),"^")_" key ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
QUIT
+2 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
+3 IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' to remove this key, eliminating all restrictions on this field, or",!,"'NO' to leave the restriction in place."
GOTO ONE
+4 IF "Yy"[SRYN
SET NUMBER=1
DO DIK
+5 QUIT
