| 1 | XUSER1 ;ISF/RWF - User file Utilities ;10/24/2002 15:57
|
|---|
| 2 | ;;8.0;KERNEL;**169,210,222**;Jul 10, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | PAGE() ;Do a page break; Return 0 if ok to continue, 1 if to abort
|
|---|
| 6 | N DIR
|
|---|
| 7 | S DIR(0)="E" D ^DIR:($E(IOST,1,2)["C-")
|
|---|
| 8 | Q:$D(DIRUT) 1 W @IOF S ($X,$Y)=0
|
|---|
| 9 | Q 0
|
|---|
| 10 | ;
|
|---|
| 11 | GKEYS(IE,XUA) ;Get the keys held. IE=user
|
|---|
| 12 | N %,V,XUB
|
|---|
| 13 | S %=0 ;Sort list alphabetical
|
|---|
| 14 | F S %=$O(^VA(200,IE,51,%)) Q:(%'>0) S V=$P($G(^DIC(19.1,%,0)),U,1) I $L(V) S XUB(V)=""
|
|---|
| 15 | S V="" ;return to user
|
|---|
| 16 | F %=1:1 S V=$O(XUB(V)) Q:'$L(V) S XUA(%)=V
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | SHLIST(ARRAY,LM,SP) ; Show a list, Array=list, LM=Left Margin, SP=spacing
|
|---|
| 20 | ;Set DN=0 to get FM22 to stop the print
|
|---|
| 21 | N %,Y2,Y4,Y5,Y6,DIR
|
|---|
| 22 | I $Y+4>IOSL,$$PAGE S DN=0 Q
|
|---|
| 23 | S Y4=-1,%=0,Y2=IOM-LM\SP,Y5=0
|
|---|
| 24 | F S %=$O(ARRAY(%)),Y4=Y4+1 Q:(%'>0)!$D(DIRUT) S Y6=$G(ARRAY(%)) D:$L(Y6)
|
|---|
| 25 | . S:Y4'<SP Y4=0 S Y5=(Y4*Y2+LM)
|
|---|
| 26 | . I $X>0,Y5+$L(Y6)'<IOM S Y4=0,Y5=(Y4*Y2+LM)
|
|---|
| 27 | . I 'Y4 W ! I $Y+3>IOSL S Y4=0,Y5=(Y4*Y2+LM) I $$PAGE S DN=0 Q
|
|---|
| 28 | . W ?Y5,Y6 S:(($X+1)>(Y5+Y2)) Y4=Y4+1
|
|---|
| 29 | . Q
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | SHPC(IE) ;Show the Person Class
|
|---|
| 33 | N %,Y S:'$D(DT) DT=$$DT^XLFDT
|
|---|
| 34 | S %=$X,Y=$$GET^XUA4A72(IE,DT)
|
|---|
| 35 | I $L(Y) W $P(Y,U,2) I $L($P(Y,U,3)) W !,?(%+2),$P(Y,U,3) I $L($P(Y,U,4)) W !,?(%+4),$P(Y,U,4)
|
|---|
| 36 | Q
|
|---|
| 37 | GMG(IE,XUA) ;Get mail groups
|
|---|
| 38 | N %,Y,XUI,Y4,Y2,XUK
|
|---|
| 39 | S %=0
|
|---|
| 40 | F S %=$O(^XMB(3.8,"AB",IE,%)) Q:%'>0 S XUA(%)=$P($G(^XMB(3.8,%,0)),U,1)
|
|---|
| 41 | Q
|
|---|
| 42 | GPARAM(IE,PRAM,XUA) ;Get an entry from the Parameter tool
|
|---|
| 43 | ;IE is the user to get the list for. PARAM what parameter, XUA return array.
|
|---|
| 44 | N XUENT,XUX,XUERR,XU1
|
|---|
| 45 | S XUENT=IE_";VA(200,"_$S($G(^VA(200,IE,5)):"^SRV.`"_+$G(^(5)),1:""),XUA=""
|
|---|
| 46 | D GETLST^XPAR(.XUX,XUENT,PRAM,"E",.XUERR)
|
|---|
| 47 | Q:XUX'>0
|
|---|
| 48 | S XUA(.5)=PRAM_":"
|
|---|
| 49 | F %=1:1:XUX S XUA(%)=$P(XUX(%),U,2)
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | DIVCHG ;Allow user to change Division [DUZ(2)] value
|
|---|
| 53 | ;Called from option: XUSER DIV CHG
|
|---|
| 54 | N Y,X,DIC,I,CD
|
|---|
| 55 | I '$D(^VA(200,+$G(DUZ),0))#2 W !,"You are not a valid user.",!!,$C(7) Q
|
|---|
| 56 | I $G(DUZ(2))="" D ;Should not happen
|
|---|
| 57 | . N XOPT D XOPT^XUS1A S DUZ(2)=$P(XOPT,U,17)
|
|---|
| 58 | S CD=$$NS^XUAF4(DUZ(2))
|
|---|
| 59 | W !,"Your current Division is ",$P(CD,U)_" "_$P(CD,U,2)
|
|---|
| 60 | S X=+$O(^VA(200,DUZ,2,0)),Y=+$O(^(X))
|
|---|
| 61 | I 'Y W !,"You do not have any choices. ",!," Change is not possible.",!! Q
|
|---|
| 62 | K DIC S DIC="^VA(200,DUZ,2,",DIC(0)="AEMNQ"
|
|---|
| 63 | S DIC("S")="I $G(^DIC(4,+Y,99))"
|
|---|
| 64 | ;Check if user has a default
|
|---|
| 65 | S X=$O(^VA(200,DUZ,2,"AX1",1,0)) S:X>0 DIC("B")=$P($$NS^XUAF4(X),U)
|
|---|
| 66 | D ^DIC K DIC
|
|---|
| 67 | I Y'>0 D Q
|
|---|
| 68 | .W !,$C(7),"Division Unchanged - Currently you are assigned to "
|
|---|
| 69 | .W $P(CD,U)_" "_$P(CD,U,2),!
|
|---|
| 70 | S DUZ(2)=+Y,CD=$$NS^XUAF4(DUZ(2))
|
|---|
| 71 | W !?5,"Division is now set to [ ",$P(CD,U)_" "_$P(CD,U,2)," ]",!
|
|---|
| 72 | Q
|
|---|
