Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORUPREF1

ORUPREF1.m

Go to the documentation of this file.
  1. 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
  1. ;;397 - WAT Add ORSUPPLY to KEY
  1. ;;539 - WAT Add OR CPRS TESTER to KEY
  1. EN ;
  1. K ORC W $C(27),"[44;37m"
  1. 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"
  1. 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)=""
  1. K ORBACK D DISP,SEL S ORF=$S(Y'=-1:Y,1:37)
  1. S ORBACK=1 D DISP,SEL S ORB=$S(Y'=-1:Y,1:40)
  1. W !,$C(27),"["_(29+ORF)_";"_(39+ORB)_"m"
  1. END K ORBACK,ORF,ORB,ORC,ORI
  1. Q
  1. 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")
  1. Q
  1. SEL S Y=-1 W !!,"Select "_$S($D(ORBACK):"BACKGROUND",1:"FOREGROUND")_" COLOR: " R X:DTIME Q:'$T!(X["^")!(X="") D UP
  1. I X="BL" W !,"Please be more specific" G SEL
  1. I $D(ORC("B",X)) S X=$O(ORC("B",X,0)) G S1
  1. 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
  1. I X'?1N!('$D(ORC(X))) W !,"Select a number for one of the choices shown" G SEL
  1. 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
  1. W $C(27),"["_($S($D(ORBACK):"44;37",1:"44;37")_"m")
  1. Q
  1. UP ;Upper case
  1. F %=1:1:$L(X) I $E(X,%)?1L S X=$E(X,1,%-1)_$C($A(X,%)-32)_$E(X,%+1,99)
  1. Q
  1. KEY ;Edit user security keys
  1. N I
  1. S OREND=0,ORVER=+($G(^DD(200,0,"VR")))
  1. F ORKEY="ORES","ORELSE","OREMAS","ORSUPPLY","OR CPRS TESTER" D K1 Q:OREND W ! F I=1:1:(IOM-1) W "="
  1. S OREND=0 K DLAYGO,DA,DR,DIE,DIC,OREND,ORK,ORKEY,ORHEAD,ORVER
  1. Q
  1. K1 N % I '$D(^DIC(19.1,"B",ORKEY)) W !,ORKEY_" is not in the Security Key file" Q
  1. 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
  1. W !!,"KEY: "_ORKEY,! S I=0 F S I=$O(^DIC(19.1,ORK,1,I)) Q:I<1 W !,^(I,0)
  1. K2 W !!,"Edit Holders" S %=1 D YN^DICN S:%=-1 OREND=1
  1. I %=0 W !!,"Enter YES to edit holders of this key, NO to quit." G K2
  1. Q:%'=1
  1. W ! D K7
  1. Q
  1. K7 ;edits holders for Kernel V7.0 in file #200
  1. N DIC,Y
  1. S DIC=200,DIC(0)="AEQM",DIC("A")="Select HOLDER: "
  1. F D ^DIC Q:Y<1 S ORDUZ=Y,ORHAVE=$D(^XUSEC(ORKEY,+ORDUZ)) D K7SET:'ORHAVE,K7DEL:ORHAVE Q:OREND
  1. K ORDUZ,ORHAVE Q
  1. K7DEL ;deletes ORKEY from person
  1. N DA,DIK
  1. W !?10,"Delete key" S %=1 D YN^DICN I (%<0) S OREND=1 Q
  1. I %=2 W !?15,"Nothing changed!",! Q
  1. I %=0 D G K7DEL
  1. .W !?7,"This person already holds the "_ORKEY_" key; answer YES"
  1. .W !?7,"to de-allocate this key from this user."
  1. .W !!?7,"HOLDER: "_$P(ORDUZ,"^",2)
  1. S DA=$O(^VA(200,+ORDUZ,51,"B",ORK,0)),DA(1)=+ORDUZ
  1. I DA S DIK="^VA(200,"_DA(1)_",51," D ^DIK
  1. W !?15,$S(DA:"DELETED!",1:"Error: ^XUSEC not consistent with keys in User file"),!
  1. Q
  1. K7SET ;allocates ORKEY to person
  1. N DIC,DA,DINUM,X
  1. I '$D(^VA(200,+ORDUZ,51,0)) S ^VA(200,+ORDUZ,51,0)="^200.051PA^^"
  1. S DA(1)=+ORDUZ,DIC="^VA(200,"_DA(1)_",51,",DIC(0)="L",(DINUM,X)=ORK
  1. D FILE^DICN W !?15,$S(Y>0:"Added.",1:"Error - not added."),!
  1. Q