source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORUPREF1.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1ORUPREF1 ; slc/dcm - Key allocation ;12/11/91 08:12 [3/13/02 11:42am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**132**;Dec 17, 1997
3EN ;
4 K ORC W $C(27),"[44;37m"
5 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"
6 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)=""
7 K ORBACK D DISP,SEL S ORF=$S(Y'=-1:Y,1:37)
8 S ORBACK=1 D DISP,SEL S ORB=$S(Y'=-1:Y,1:40)
9 W !,$C(27),"["_(29+ORF)_";"_(39+ORB)_"m"
10END K ORBACK,ORF,ORB,ORC,ORI
11 Q
12DISP 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")
13 Q
14SEL S Y=-1 W !!,"Select "_$S($D(ORBACK):"BACKGROUND",1:"FOREGROUND")_" COLOR: " R X:DTIME Q:'$T!(X["^")!(X="") D UP
15 I X="BL" W !,"Please be more specific" G SEL
16 I $D(ORC("B",X)) S X=$O(ORC("B",X,0)) G S1
17 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
18 I X'?1N!('$D(ORC(X))) W !,"Select a number for one of the choices shown" G SEL
19S1 W " ",$C(27),"["_($S($D(ORBACK):40+$P(ORC(X),"^",2),1:30+$P(ORC(X),"^",2))_"m"),$P(ORC(X),"^") S Y=X
20 W $C(27),"["_($S($D(ORBACK):"44;37",1:"44;37")_"m")
21 Q
22UP ;Upper case
23 F %=1:1:$L(X) I $E(X,%)?1L S X=$E(X,1,%-1)_$C($A(X,%)-32)_$E(X,%+1,99)
24 Q
25KEY ;Edit user security keys
26 S OREND=0,ORVER=+($G(^DD(200,0,"VR")))
27 F ORKEY="ORES","ORELSE","OREMAS" D K1 Q:OREND W ! F I=1:1:(IOM-1) W "="
28 S OREND=0 K DLAYGO,DA,DR,DIE,DIC,OREND,ORK,ORKEY,ORHEAD,ORVER
29 Q
30K1 I '$D(^DIC(19.1,"B",ORKEY)) W !,ORKEY_" is not in the Security Key file" Q
31 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
32 W !!,"KEY: "_ORKEY,! S I=0 F S I=$O(^DIC(19.1,ORK,1,I)) Q:I<1 W !,^(I,0)
33K2 W !!,"Edit Holders" S %=1 D YN^DICN S:%=-1 OREND=1
34 I %=0 W !!,"Enter YES to edit holders of this key, NO to quit." G K2
35 Q:%'=1
36 W ! D K7
37 Q
38K7 ;edits holders for Kernel V7.0 in file #200
39 S DIC=200,DIC(0)="AEQM",DIC("A")="Select HOLDER: "
40 F D ^DIC Q:Y<1 S ORDUZ=Y,ORHAVE=$D(^XUSEC(ORKEY,+ORDUZ)) D K7SET:'ORHAVE,K7DEL:ORHAVE Q:OREND
41 K ORDUZ,ORHAVE Q
42K7DEL ;deletes ORKEY from person
43 N DA,DIC,DIK
44 W !?10,"Delete key" S %=1 D YN^DICN I (%<0) S OREND=1 Q
45 I %=2 W !?15,"Nothing changed!",! Q
46 I %=0 D G K7DEL
47 .W !?7,"This person already holds the "_ORKEY_" key; answer YES"
48 .W !?7,"to de-allocate this key from this user."
49 .W !!?7,"HOLDER: "_$P(ORDUZ,"^",2)
50 S DA=$O(^VA(200,+ORDUZ,51,"B",ORK,0)),DA(1)=+ORDUZ
51 I DA S DIK="^VA(200,"_DA(1)_",51," D ^DIK
52 W !?15,$S(DA:"DELETED!",1:"Error: ^XUSEC not consistent with keys in User file"),!
53 Q
54K7SET ;allocates ORKEY to person
55 N DIC,DA
56 I '$D(^VA(200,+ORDUZ,51,0)) S ^VA(200,+ORDUZ,51,0)="^200.051PA^^"
57 S DA(1)=+ORDUZ,DIC="^VA(200,"_DA(1)_",51,",DIC(0)="L",(DINUM,X)=ORK
58 D FILE^DICN W !?15,$S(Y>0:"Added.",1:"Error - not added."),!
59 Q
Note: See TracBrowser for help on using the repository browser.