source: cprs/branches/tmg-cprs/m_files/TMGRPC3C.m@ 1099

Last change on this file since 1099 was 796, checked in by Kevin Toppenberg, 15 years ago

Initial upload
File size: 8.0 KB
Line 
1TMGRPC3C ;TMG/kst/Support Functions for GUI_Config ;08/31/08
2 ;;1.0;TMG-LIB;**1**;08/12/09
3 ;
4 ;"TMG RPC FUNCTIONS for a GUI config program
5 ;
6 ;"Kevin Toppenberg MD
7 ;"GNU Lessor General Public License (LGPL) applies
8 ;"7/20/08
9 ;
10 ;"=======================================================================
11 ;" RPC -- Public Functions.
12 ;"=======================================================================
13 ;" <none>
14 ;"=======================================================================
15 ;"PRIVATE API FUNCTIONS
16 ;"=======================================================================
17 ;"POSTDATA(TMGOUT,TMGDATA) -- Post Changes to database via Fileman
18 ;
19 ;"=======================================================================
20 ;"Dependencies:
21 ;" TMGRPC3* only
22 ;
23 ;"=======================================================================
24 ;
25POSTDATA(TMGOUT,TMGDATA,TMGFLAG) ;
26 ;"Post Changes to database via Fileman
27 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
28 ;" TMGDATA -- Entries to be filed. Format:
29 ;" TMGDATA(0)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
30 ;" TMGDATA(1)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
31 ;" TMGDATA(2)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue
32 ;" ...
33 ;" Note: FieldName, oldValue pieces are not used (optional)
34 ;" TMGFLAG -- OPTIONAL, "E" is default. Flag passed to FILE^DIE or UPDATE^DIE
35 ;" should be "E" or "I"
36 ;"Output: TMGOUT is filled as follows:
37 ;" TMGOUT(0)="1^Success" or "-1^Short Message"
38 ;" TMGOUT(1)=Fileman message (long)
39 ;" -or if new records added:
40 ;" TMGOUT(1)=5^1234 ,c<-- results of IEN array returned (+5 converted to record 1234)
41 ;" TMGOUT(2)=3^2341 <-- results of IEN array returned (+3 converted to record 2341)
42 ;" ...
43 ;"Results: none
44 ;
45 NEW TMGAVC SET TMGAVC=0 ;"TMGAVC=AccessVerifyCode. Default to no change.
46 NEW TMGINACTUSER,TMGREACTUSER
47 SET TMGFLAG=$GET(TMGFLAG,"E")
48 NEW TMGI SET TMGI=""
49 NEW TMGFDA,TMGNEWFDA,TMGMSG,TMGIEN,DIC
50 NEW TMGOLDDUZ ;"elh - to save previous fiel access level
51 NEW TMGINTFDA
52 FOR SET TMGI=$ORDER(TMGDATA(TMGI)) QUIT:(TMGI="") DO
53 . NEW TMGFILE,TMGIENS,TMGFIELD,TMGVALUE,TMGONEENTRY
54 . NEW TMGINTVALUE SET TMGINTVALUE=0
55 . NEW TMGCONTINUE SET TMGCONTINUE=0
56 . SET TMGONEENTRY=$GET(TMGDATA(TMGI))
57 . SET TMGFILE=$PIECE(TMGONEENTRY,"^",1)
58 . SET TMGIENS=$PIECE(TMGONEENTRY,"^",2)
59 . SET TMGFIELD=$PIECE(TMGONEENTRY,"^",3)
60 . SET TMGVALUE=$PIECE(TMGONEENTRY,"^",5)
61 . IF TMGFILE=200 DO
62 . . IF TMGFIELD=2 DO ;"2 = Access Code
63 . . . SET TMGOLDDUZ=DUZ(0) ;"elh Save File Access Level
64 . . . SET DUZ(0)="^" ;"elh Set proper write access level
65 . . . IF TMGIENS["+" DO QUIT
66 . . . . SET TMGCONTINUE=1
67 . . . . SET TMGOUT(1)="Can't set Access code when first adding new user. Try again."
68 . . . ;"NOTICE: currently this code DOes NOT force code of certain length etc.
69 . . . ;"S Y=$$VCHK(XV2,XUH) Q:Y Y ;check for valid verify code, returns 0 (for OK), or 1^msg
70 . . . ;"SET TMGVALUE=$$UP^XLFSTR(TMGVALUE) ;"access code must be upper case elh
71 . . . SET TMGVALUE=$$EN^XUSHSH(TMGVALUE) ;"access code is supposed to be hashed first
72 . . . SET TMGAVC=1 ;"signal change
73 . . . SET TMGAVC("DA")=+TMGIENS
74 . . . SET TMGINTVALUE=1
75 . . ELSE IF TMGFIELD=11 DO ;"11 = Verify Code
76 . . . SET TMGOLDDUZ=DUZ(0) ;" elh Save File Access Level
77 . . . SET DUZ(0)="^" ;" elh Set proper write access level
78 . . . IF TMGIENS["+" DO QUIT
79 . . . . SET TMGCONTINUE=1
80 . . . . SET TMGOUT(1)="Can't set Verify code when first adding new user. Try again."
81 . . . ;"NOTICE: currently this code does NOT force code of certain length etc.
82 . . . ;"S Y=$$VCHK(XV2,XUH) Q:Y Y ;check for valid verify code, returns 0 (for OK), or 1^msg
83 . . . ;"SET TMGVALUE=$$UP^XLFSTR(TMGVALUE) ;"verify code must be upper case elh
84 . . . SET TMGVALUE=$$EN^XUSHSH(TMGVALUE) ;"verify code is supposed to be hashed first
85 . . . SET TMGAVC=1 ;"signal change
86 . . . SET TMGAVC("DA")=+TMGIENS
87 . . . SET TMGINTVALUE=1
88 . . ELSE IF TMGFIELD=7 DO ;"7 = DISUSER Value should be 'YES' or 'NO'
89 . . . IF TMGIENS["+" DO QUIT
90 . . . . SET TMGCONTINUE=1
91 . . . . SET TMGOUT(1)="Can't set DISUSER code when first adding new user. Try again."
92 . . . IF TMGVALUE="YES" DO
93 . . . . SET TMGFDA(200,TMGIENS,9.2)="NOW" ;"add 9.2 = termination date
94 . . . . SET TMGINACTUSER("DA")=+TMGIENS
95 . . . IF (TMGVALUE="NO")!(TMGVALUE="@") DO
96 . . . . SET TMGFDA(200,TMGIENS,9.2)="@" ;"delete 9.2 = termination date
97 . . . . SET TMGFDA(200,TMGIENS,9.4)="@" ;"delete 9.4 = termination reason
98 . . . . SET TMGREACTUSER("DA")=+TMGIENS
99 . . ELSE IF TMGFIELD=3 DO ;"3 = FILE MANAGER ACCESS CODE (i.e. @ etc)
100 . . . IF TMGVALUE'["^" DO
101 . . . . SET $PIECE(^VA(200,+TMGIENS,0),"^",4)=TMGVALUE ;"force value in with low-level write
102 . . . . SET TMGCONTINUE=1
103 . IF TMGCONTINUE QUIT
104 . IF TMGIENS["+" DO
105 . . SET TMGNEWFDA(TMGFILE,TMGIENS,TMGFIELD)=TMGVALUE
106 . ELSE DO
107 . . IF TMGINTVALUE=1 SET TMGINTFDA(TMGFILE,TMGIENS,TMGFIELD)=TMGVALUE
108 . . ELSE SET TMGFDA(TMGFILE,TMGIENS,TMGFIELD)=TMGVALUE
109 . IF $DATA(TMGOLDDUZ) DO ;"elh reset file access
110 . . SET DUZ(0)=TMGOLDDUZ
111 . . KILL TMGOLDDUZ
112 ;
113
114 SET TMGOUT(0)="1^Success" ;"default to success
115 IF $DATA(TMGFDA) DO
116 . DO FILE^DIE(TMGFLAG_"K","TMGFDA","TMGMSG")
117 IF $DATA(TMGMSG("DIERR")) DO
118 . SET TMGOUT(0)="-1^See Fileman message re posting"
119 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)_";"_$GET(TMGOUT(1))
120 ;
121 IF $DATA(TMGINTFDA) DO ;"process FDA with INTERNAL values
122 . DO FILE^DIE("K","TMGINTFDA","TMGMSG")
123 IF $DATA(TMGMSG("DIERR")) DO
124 . SET TMGOUT(0)="-1^See Fileman message re posting"
125 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)_";"_$GET(TMGOUT(1))
126 ;
127 IF $DATA(TMGNEWFDA) DO
128 . DO UPDATE^DIE(TMGFLAG_"K","TMGNEWFDA","TMGIEN","TMGMSG")
129 IF $DATA(TMGMSG("DIERR")) DO
130 . SET TMGOUT(0)="-1^See Fileman message re posting"
131 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)_";"_$GET(TMGOUT(1))
132 ;
133 IF ($PIECE(TMGOUT(0),"^",1)=1)&($DATA(TMGIEN)) DO
134 . NEW TMGCOUNT SET TMGCOUNT=1
135 . NEW TMGI SET TMGI=""
136 . FOR SET TMGI=$ORDER(TMGIEN(TMGI)) QUIT:(TMGI="") DO
137 . . SET TMGOUT(TMGCOUNT)=TMGI_"^"_$GET(TMGIEN(TMGI))
138 . . SET TMGCOUNT=TMGCOUNT+1
139 ;
140 ;"If Access code / Verify code changed, then finish some follow up business
141 ;" as per BRCVC^XUS2<--CVC^XUSRB<--called by RPC 'XUS CVC'
142 IF TMGAVC DO
143 . NEW DA SET DA=TMGAVC("DA")
144 . DO CALL^XUSERP(DA,2) ;"Call for Kernel Create, **Update**, Disuser or Terminate events
145 . ;"The above sets Taskman job -->DEQUE^XUSERP--> --> D HL7^ALPBGEN
146 ;
147 IF $DATA(TMGINACTUSER) DO ;"Finish up inactivating user with VistA code
148 . NEW TMGRESULT
149 . SET TMGRESULT=$$QTERMUSR^TMGRPC3D(TMGINACTUSER("DA")) ;"finish termination of user code
150 . IF +TMGRESULT'=0 DO
151 . . SET TMGOUT(0)="-1^See Fileman message re terminating user"
152 . . SET TMGOUT(1)=TMGOUT(1)_";"_TMGRESULT
153 ;
154 IF $DATA(TMGREACTUSER) DO ;"finish up reactivating user with VistA code
155 . NEW TMGRESULT
156 . SET TMGRESULT=$$QTREAUSR^TMGRPC3D(TMGREACTUSER("DA")) ;"launch quiet reactivation code
157 . IF +TMGRESULT'=0 DO
158 . . SET TMGOUT(0)="-1^See Fileman message re reactivating user"
159 . . SET TMGOUT(1)=TMGOUT(1)_";"_TMGRESULT
160 ;
161 QUIT
Note: See TracBrowser for help on using the repository browser.