ORUPREF1 ; slc/dcm - Key allocation ;Jan 08, 2021@11:59:33
;;3.0;ORDER ENTRY/RESULTS REPORTING;**132,397,539**;Dec 17, 1997;Build 41
;;397 - WAT Add ORSUPPLY to KEY
;;539 - WAT Add OR CPRS TESTER to KEY
EN ;
K ORC W $C(27),"[44;37m"
S ORC(1)="Black^0",ORC(2)="Red^1",ORC(3)="Green^2",ORC(4)="Yellow^3",ORC(5)="Blue^4",ORC(6)="Magenta^5",ORC(7)="Cyan^6",ORC(8)="White^7"
S ORC("B","BLACK",1)="",ORC("B","RED",2)="",ORC("B","GREEN",3)="",ORC("B","YELLOW",4)="",ORC("B","BLUE",5)="",ORC("B","MAGENTA",6)="",ORC("B","CYAN",7)="",ORC("B","WHITE",8)=""
K ORBACK D DISP,SEL S ORF=$S(Y'=-1:Y,1:37)
S ORBACK=1 D DISP,SEL S ORB=$S(Y'=-1:Y,1:40)
W !,$C(27),"["_(29+ORF)_";"_(39+ORB)_"m"
END K ORBACK,ORF,ORB,ORC,ORI
Q
DISP F ORI=1:1:8 W !?10,$C(27),"["_($S($D(ORBACK):40+$P(ORC(ORI),"^",2),1:30+$P(ORC(ORI),"^",2))_"m"),ORI_" ",$P(ORC(ORI),"^")_$E(" ",1,7-$L($P(ORC(ORI),"^"))) W $C(27),"["_($S($D(ORBACK):"44;37",1:"44;37")_"m")
Q
SEL S Y=-1 W !!,"Select "_$S($D(ORBACK):"BACKGROUND",1:"FOREGROUND")_" COLOR: " R X:DTIME Q:'$T!(X["^")!(X="") D UP
I X="BL" W !,"Please be more specific" G SEL
I $D(ORC("B",X)) S X=$O(ORC("B",X,0)) G S1
I $E($O(ORC("B",X)),1,$L(X))=X,X'="BL" S X=$O(ORC("B",X)),X=$O(ORC("B",X,0)) G S1
I X'?1N!('$D(ORC(X))) W !,"Select a number for one of the choices shown" G SEL
S1 W " ",$C(27),"["_($S($D(ORBACK):40+$P(ORC(X),"^",2),1:30+$P(ORC(X),"^",2))_"m"),$P(ORC(X),"^") S Y=X
W $C(27),"["_($S($D(ORBACK):"44;37",1:"44;37")_"m")
Q
UP ;Upper case
F %=1:1:$L(X) I $E(X,%)?1L S X=$E(X,1,%-1)_$C($A(X,%)-32)_$E(X,%+1,99)
Q
KEY ;Edit user security keys
N I
S OREND=0,ORVER=+($G(^DD(200,0,"VR")))
F ORKEY="ORES","ORELSE","OREMAS","ORSUPPLY","OR CPRS TESTER" D K1 Q:OREND W ! F I=1:1:(IOM-1) W "="
S OREND=0 K DLAYGO,DA,DR,DIE,DIC,OREND,ORK,ORKEY,ORHEAD,ORVER
Q
K1 N % I '$D(^DIC(19.1,"B",ORKEY)) W !,ORKEY_" is not in the Security Key file" Q
S ORK=$O(^DIC(19.1,"B",ORKEY,0)) I 'ORK!('$D(^DIC(19.1,ORK))) W !,ORKEY_" is not in the Security Key file" Q
W !!,"KEY: "_ORKEY,! S I=0 F S I=$O(^DIC(19.1,ORK,1,I)) Q:I<1 W !,^(I,0)
K2 W !!,"Edit Holders" S %=1 D YN^DICN S:%=-1 OREND=1
I %=0 W !!,"Enter YES to edit holders of this key, NO to quit." G K2
Q:%'=1
W ! D K7
Q
K7 ;edits holders for Kernel V7.0 in file #200
N DIC,Y
S DIC=200,DIC(0)="AEQM",DIC("A")="Select HOLDER: "
F D ^DIC Q:Y<1 S ORDUZ=Y,ORHAVE=$D(^XUSEC(ORKEY,+ORDUZ)) D K7SET:'ORHAVE,K7DEL:ORHAVE Q:OREND
K ORDUZ,ORHAVE Q
K7DEL ;deletes ORKEY from person
N DA,DIK
W !?10,"Delete key" S %=1 D YN^DICN I (%<0) S OREND=1 Q
I %=2 W !?15,"Nothing changed!",! Q
I %=0 D G K7DEL
.W !?7,"This person already holds the "_ORKEY_" key; answer YES"
.W !?7,"to de-allocate this key from this user."
.W !!?7,"HOLDER: "_$P(ORDUZ,"^",2)
S DA=$O(^VA(200,+ORDUZ,51,"B",ORK,0)),DA(1)=+ORDUZ
I DA S DIK="^VA(200,"_DA(1)_",51," D ^DIK
W !?15,$S(DA:"DELETED!",1:"Error: ^XUSEC not consistent with keys in User file"),!
Q
K7SET ;allocates ORKEY to person
N DIC,DA,DINUM,X
I '$D(^VA(200,+ORDUZ,51,0)) S ^VA(200,+ORDUZ,51,0)="^200.051PA^^"
S DA(1)=+ORDUZ,DIC="^VA(200,"_DA(1)_",51,",DIC(0)="L",(DINUM,X)=ORK
D FILE^DICN W !?15,$S(Y>0:"Added.",1:"Error - not added."),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORUPREF1 3243 printed Sep 23, 2025@20:10:48 Page 2
ORUPREF1 ; slc/dcm - Key allocation ;Jan 08, 2021@11:59:33
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**132,397,539**;Dec 17, 1997;Build 41
+2 ;;397 - WAT Add ORSUPPLY to KEY
+3 ;;539 - WAT Add OR CPRS TESTER to KEY
EN ;
+1 KILL ORC
WRITE $CHAR(27),"[44;37m"
+2 SET ORC(1)="Black^0"
SET ORC(2)="Red^1"
SET ORC(3)="Green^2"
SET ORC(4)="Yellow^3"
SET ORC(5)="Blue^4"
SET ORC(6)="Magenta^5"
SET ORC(7)="Cyan^6"
SET ORC(8)="White^7"
+3 SET ORC("B","BLACK",1)=""
SET ORC("B","RED",2)=""
SET ORC("B","GREEN",3)=""
SET ORC("B","YELLOW",4)=""
SET ORC("B","BLUE",5)=""
SET ORC("B","MAGENTA",6)=""
SET ORC("B","CYAN",7)=""
SET ORC("B","WHITE",8)=""
+4 KILL ORBACK
DO DISP
DO SEL
SET ORF=$SELECT(Y'=-1:Y,1:37)
+5 SET ORBACK=1
DO DISP
DO SEL
SET ORB=$SELECT(Y'=-1:Y,1:40)
+6 WRITE !,$CHAR(27),"["_(29+ORF)_";"_(39+ORB)_"m"
END KILL ORBACK,ORF,ORB,ORC,ORI
+1 QUIT
DISP FOR ORI=1:1:8
WRITE !?10,$CHAR(27),"["_($SELECT($DATA(ORBACK):40+$PIECE(ORC(ORI),"^",2),1:30+$PIECE(ORC(ORI),"^",2))_"m"),ORI_" ",$PIECE(ORC(ORI),"^")_$EXTRACT(" ",1,7-$LENGTH($PIECE(ORC(ORI),"^")))
WRITE $CHAR(27),"["_($SELECT($DATA(ORBACK):"44;37",1:"44;37")_"m")
+1 QUIT
SEL SET Y=-1
WRITE !!,"Select "_$SELECT($DATA(ORBACK):"BACKGROUND",1:"FOREGROUND")_" COLOR: "
READ X:DTIME
if '$TEST!(X["^")!(X="")
QUIT
DO UP
+1 IF X="BL"
WRITE !,"Please be more specific"
GOTO SEL
+2 IF $DATA(ORC("B",X))
SET X=$ORDER(ORC("B",X,0))
GOTO S1
+3 IF $EXTRACT($ORDER(ORC("B",X)),1,$LENGTH(X))=X
IF X'="BL"
SET X=$ORDER(ORC("B",X))
SET X=$ORDER(ORC("B",X,0))
GOTO S1
+4 IF X'?1N!('$DATA(ORC(X)))
WRITE !,"Select a number for one of the choices shown"
GOTO SEL
S1 WRITE " ",$CHAR(27),"["_($SELECT($DATA(ORBACK):40+$PIECE(ORC(X),"^",2),1:30+$PIECE(ORC(X),"^",2))_"m"),$PIECE(ORC(X),"^")
SET Y=X
+1 WRITE $CHAR(27),"["_($SELECT($DATA(ORBACK):"44;37",1:"44;37")_"m")
+2 QUIT
UP ;Upper case
+1 FOR %=1:1:$LENGTH(X)
IF $EXTRACT(X,%)?1L
SET X=$EXTRACT(X,1,%-1)_$CHAR($ASCII(X,%)-32)_$EXTRACT(X,%+1,99)
+2 QUIT
KEY ;Edit user security keys
+1 NEW I
+2 SET OREND=0
SET ORVER=+($GET(^DD(200,0,"VR")))
+3 FOR ORKEY="ORES","ORELSE","OREMAS","ORSUPPLY","OR CPRS TESTER"
DO K1
if OREND
QUIT
WRITE !
FOR I=1:1:(IOM-1)
WRITE "="
+4 SET OREND=0
KILL DLAYGO,DA,DR,DIE,DIC,OREND,ORK,ORKEY,ORHEAD,ORVER
+5 QUIT
K1 NEW %
IF '$DATA(^DIC(19.1,"B",ORKEY))
WRITE !,ORKEY_" is not in the Security Key file"
QUIT
+1 SET ORK=$ORDER(^DIC(19.1,"B",ORKEY,0))
IF 'ORK!('$DATA(^DIC(19.1,ORK)))
WRITE !,ORKEY_" is not in the Security Key file"
QUIT
+2 WRITE !!,"KEY: "_ORKEY,!
SET I=0
FOR
SET I=$ORDER(^DIC(19.1,ORK,1,I))
if I<1
QUIT
WRITE !,^(I,0)
K2 WRITE !!,"Edit Holders"
SET %=1
DO YN^DICN
if %=-1
SET OREND=1
+1 IF %=0
WRITE !!,"Enter YES to edit holders of this key, NO to quit."
GOTO K2
+2 if %'=1
QUIT
+3 WRITE !
DO K7
+4 QUIT
K7 ;edits holders for Kernel V7.0 in file #200
+1 NEW DIC,Y
+2 SET DIC=200
SET DIC(0)="AEQM"
SET DIC("A")="Select HOLDER: "
+3 FOR
DO ^DIC
if Y<1
QUIT
SET ORDUZ=Y
SET ORHAVE=$DATA(^XUSEC(ORKEY,+ORDUZ))
if 'ORHAVE
DO K7SET
if ORHAVE
DO K7DEL
if OREND
QUIT
+4 KILL ORDUZ,ORHAVE
QUIT
K7DEL ;deletes ORKEY from person
+1 NEW DA,DIK
+2 WRITE !?10,"Delete key"
SET %=1
DO YN^DICN
IF (%<0)
SET OREND=1
QUIT
+3 IF %=2
WRITE !?15,"Nothing changed!",!
QUIT
+4 IF %=0
Begin DoDot:1
+5 WRITE !?7,"This person already holds the "_ORKEY_" key; answer YES"
+6 WRITE !?7,"to de-allocate this key from this user."
+7 WRITE !!?7,"HOLDER: "_$PIECE(ORDUZ,"^",2)
End DoDot:1
GOTO K7DEL
+8 SET DA=$ORDER(^VA(200,+ORDUZ,51,"B",ORK,0))
SET DA(1)=+ORDUZ
+9 IF DA
SET DIK="^VA(200,"_DA(1)_",51,"
DO ^DIK
+10 WRITE !?15,$SELECT(DA:"DELETED!",1:"Error: ^XUSEC not consistent with keys in User file"),!
+11 QUIT
K7SET ;allocates ORKEY to person
+1 NEW DIC,DA,DINUM,X
+2 IF '$DATA(^VA(200,+ORDUZ,51,0))
SET ^VA(200,+ORDUZ,51,0)="^200.051PA^^"
+3 SET DA(1)=+ORDUZ
SET DIC="^VA(200,"_DA(1)_",51,"
SET DIC(0)="L"
SET (DINUM,X)=ORK
+4 DO FILE^DICN
WRITE !?15,$SELECT(Y>0:"Added.",1:"Error - not added."),!
+5 QUIT
