| 1 | TMGHRPC1 ;TMG/elh/Support Functions for GUI_Config ;10/20/09
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;10/20/09
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG Function to change Access/Verify Code
|
|---|
| 5 | ;"When either an IEN, Access Code, or Name is Supplied
|
|---|
| 6 | ;"The IEN or name can be passed directly, the Access Code should be preceeded
|
|---|
| 7 | ;"by an underscore.
|
|---|
| 8 | ;
|
|---|
| 9 | ;"Eddie Hagood
|
|---|
| 10 | ;"GNU Lessor General Public License (LGPL) applies
|
|---|
| 11 | ;"10/20/09
|
|---|
| 12 | ;
|
|---|
| 13 | ;"=======================================================================
|
|---|
| 14 | ;" RPC -- Public Functions.
|
|---|
| 15 | ;"=======================================================================
|
|---|
| 16 | ;" <none>
|
|---|
| 17 | ;"=======================================================================
|
|---|
| 18 | ;"PRIVATE API FUNCTIONS
|
|---|
| 19 | ;"=======================================================================
|
|---|
| 20 | ;"CHANGEAVCODE(TMGOUT,TMGDATA) -- Post Changes to database via Fileman
|
|---|
| 21 | ;
|
|---|
| 22 | ;"=======================================================================
|
|---|
| 23 | ;"Dependencies:
|
|---|
| 24 | ;" TMGRPC3* only
|
|---|
| 25 | ;
|
|---|
| 26 | ;"=======================================================================
|
|---|
| 27 | ;
|
|---|
| 28 | CHANGEAVCODE(TMGUSER,TMGNEWAC,TMGNEWVC)
|
|---|
| 29 | ;"Post new access and verify codes to database via Fileman
|
|---|
| 30 | ;"Input: TMGUSER -- User name, IEN, or Access Code (preceeded by an underscore)
|
|---|
| 31 | ;" TMGNEWAC -- New Access Code, Sent By User
|
|---|
| 32 | ;" TMGNEWVC -- New Verify Code, Sent By User
|
|---|
| 33 | ;"Results: none
|
|---|
| 34 | ;
|
|---|
| 35 | NEW TMGAVC SET TMGAVC=0 ;"TMGAVC=AccessVerifyCode. Default to no change.
|
|---|
| 36 | NEW TMGINACTUSER,TMGREACTUSER
|
|---|
| 37 | NEW TMGI SET TMGI=""
|
|---|
| 38 | NEW TMGFDA,TMGNEWFDA,TMGMSG,TMGIEN,DIC
|
|---|
| 39 | ;
|
|---|
| 40 | SET TMGUSER=$TRANSLATE(TMGUSER,"""","")
|
|---|
| 41 | ;WRITE TMGUSER,!
|
|---|
| 42 | IF +$GET(TMGUSER)>0 SET Y=+TMGUSER GOTO L2
|
|---|
| 43 | ;WRITE TMGUSER,!
|
|---|
| 44 | SET TMGUSER=$$UP^XLFSTR(TMGUSER)
|
|---|
| 45 | ;WRITE TMGUSER,!
|
|---|
| 46 | IF $EXTRACT(TMGUSER,1)="_" DO GOTO L1
|
|---|
| 47 | . ;WRITE TMGUSER,!
|
|---|
| 48 | . SET TMGUSER=$EXTRACT(TMGUSER,2,999)
|
|---|
| 49 | . ;WRITE TMGUSER,!
|
|---|
| 50 | . SET TMGUSER=$$EN^XUSHSH(TMGUSER) ;Hash Access Code
|
|---|
| 51 | . ;WRITE TMGUSER,!
|
|---|
| 52 | . SET Y=$ORDER(^VA(200,"A",TMGUSER,""))
|
|---|
| 53 | . ;WRITE "("_Y_")"
|
|---|
| 54 | ;
|
|---|
| 55 | ;WRITE TMGUSER,!
|
|---|
| 56 | SET Y=+$ORDER(^VA(200,"B",TMGUSER,""))
|
|---|
| 57 | ;
|
|---|
| 58 | L1 ;
|
|---|
| 59 | IF Y'>0 WRITE "CAN'T FIND THAT USER ("_TMGUSER_"-"_Y_")" QUIT
|
|---|
| 60 | L2 ;
|
|---|
| 61 | ;"SET TMGOLDAC=$$EN^XUSHSH(TMGOLDAC) ;Hash Access Code
|
|---|
| 62 | SET TMGNEWAC=$$UP^XLFSTR(TMGNEWAC) ;Access Code Must Be Uppercase
|
|---|
| 63 | SET TMGNEWAC=$$EN^XUSHSH(TMGNEWAC) ;Hash Access Code
|
|---|
| 64 | ;
|
|---|
| 65 | SET TMGNEWVC=$$UP^XLFSTR(TMGNEWVC) ;"verify code must be upper case elh
|
|---|
| 66 | SET TMGNEWVC=$$EN^XUSHSH(TMGNEWVC) ;"verify code is supposed to be hashed first
|
|---|
| 67 | SET TMGOLDAC=$PIECE(^VA(200,Y,0),"^",3)
|
|---|
| 68 | SET $PIECE(^VA(200,Y,0),"^",3)=TMGNEWAC
|
|---|
| 69 | KILL ^VA(200,"A",TMGOLDAC)
|
|---|
| 70 | SET ^VA(200,"A",TMGNEWAC,Y)=+$H
|
|---|
| 71 | SET $PIECE(^VA(200,Y,.1),"^",2)=TMGNEWVC
|
|---|
| 72 | ;
|
|---|
| 73 | QUIT
|
|---|
| 74 | |
|---|
