source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU9.m@ 1036

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

revised back to 6/30/08 version
File size: 4.3 KB
RevLine 
[623]1MAGGTU9 ;WOIFO/LB/GEK - Imaging utilities assign key
2 ;;3.0;IMAGING;**8**;Sep 15, 2004
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19EN ;Give MAGDISP CLIN key to all MAG WINDOWS option holders.
20 ; Find the menu option's IEN
21 N MKEY,ERR,OPT,MAGUSER,I,KEYNM,KEYCT,KEYECT,XCT,KEYHAS
22 N UCT,UTOT,OPTACC,MDOT
23 S KEYNM="MAGDISP CLIN"
24 S KEYCT=0 ; count of number of users that were assigned the key.
25 S KEYECT=0 ; count of number of errors during the assignment.
26 S KEYHAS=0 ; count of number of users that already have key.
27 S OPTACC=0 ; count of users with access to MAG WINDOWS.
28 S MDOT=10000 ; print '.' to screen to show progress.
29 S UCT=0 ; user count. for progress
30 S UTOT=$P(^VA(200,0),"^",4)
31 ;
32 D MES^XPDUTL("Assigning "_KEYNM_" to all users with access to Option : "_"MAG WINDOWS")
33 S OPT=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","ERR")
34 I OPT="" D MES^XPDUTL("ERROR ",$G(ERR("DIERR",1,"TEXT",1))) Q
35 I OPT=0 D MES^XPDUTL("MAG WINDOWS wasn't found in Option File") Q
36 ; Lookup the security key
37 S MKEY=$$LKUP^XPDKEY(KEYNM)
38 I 'MKEY D MES^XPDUTL("ERROR "_KEYNM_" Key wasn't found") Q
39 ; Give users the Key, if they don't have it already
40 D MES^XPDUTL("Checking users...")
41 S I=0 F S I=$O(^VA(200,I)) Q:'I D
42 . S UCT=UCT+1 I UCT>MDOT S MDOT=MDOT+10000 D MES^XPDUTL(UCT_" of "_UTOT_" users checked...")
43 . I (($$ACCESS^XQCHK(I,OPT))>0) S OPTACC=OPTACC+1 D GIVEKEY(MKEY,KEYNM,I)
44 . Q
45 D MES^XPDUTL(OPTACC_" of "_UTOT_" Users have access to option MAG WINDOWS.")
46 D MES^XPDUTL(KEYHAS_" Users already have Key "_KEYNM)
47 D MES^XPDUTL(KEYCT_" Users were assigned key: "_KEYNM)
48 D MES^XPDUTL("Assignment Complete.")
49 I KEYECT>0 D MES^XPDUTL(KEYECT_" Errors during Key Assignment. See install log for details")
50 Q
51GIVEKEY(KEY,KEYNM,USER) ;
52 ; Give KEY to USER
53 N DO,D1,MFDA,Z,MIEN
54 ; Quit if they already have the key
55 S Z=$$FIND1^DIC(200.051,","_USER_",","",KEYNM)
56 I +Z S KEYHAS=KEYHAS+1
57 Q:Z ; Already have key
58 I Z="" D Q
59 . D MES^XPDUTL("ERROR Validating that user ("_USER_") has key ("_KEYNM_")")
60 . S KEYECT=KEYECT+1
61 ;
62 S MFDA(200.051,"+1,"_USER_",",.01)=KEY
63 S MFDA(200.051,"+1,"_USER_",",1)=DUZ
64 S MFDA(200.051,"+1,"_USER_",",2)=DT
65 S MIEN(1)=KEY_","
66 D UPDATE^DIE("","MFDA","MIEN")
67 I $D(DIERR) D Q
68 . D MES^XPDUTL("ERROR Assigning key ("_KEYNM_") to user ("_USER_")")
69 . S KEYECT=KEYECT+1
70 . D CLEAN^DILF
71 . Q
72 S KEYCT=KEYCT+1
73 D CLEAN^DILF
74 Q
75FLT ; Create a Few Public Filters as a default for sites.
76 ; Only create new public filters if file is empty.
77 N DIK
78 I +$P(^MAG(2005.87,0),"^",3) D Q
79 . D MES^XPDUTL("The IMAGE LIST FILTERS File is not empty,")
80 . D MES^XPDUTL(" Default Public Filters were not installed.")
81 . Q
82 S ^MAG(2005.87,1,0)="Rad All^RAD^CLIN^^^^^^0"
83 S ^MAG(2005.87,1,1)="^1^.05"
84 S ^MAG(2005.87,2,0)="Clin All^^CLIN^^^^^^0"
85 S ^MAG(2005.87,2,1)="^1^.05"
86 S ^MAG(2005.87,3,0)="Admin All^^ADMIN^^^^^^0"
87 S ^MAG(2005.87,3,1)="^1^.05"
88 S ^MAG(2005.87,4,0)="Clin 2 yr^^CLIN^^^^^^-24"
89 S ^MAG(2005.87,4,1)="^1^.05"
90 S ^MAG(2005.87,5,0)="Admin 10-10EZ All^^ADMIN^46,^^^^^0"
91 S ^MAG(2005.87,5,1)="^1^.05"
92 S ^MAG(2005.87,6,0)="Adv Directives^^CLIN^67^^^^^0"
93 S ^MAG(2005.87,6,1)="^1^.05"
94 S ^MAG(2005.87,7,0)="All^^^^^^^^0"
95 S ^MAG(2005.87,7,1)="^1^.05"
96 S ^MAG(2005.87,8,0)="All 2 yr^^^^^^^^-24"
97 S ^MAG(2005.87,8,1)="^1^.05"
98 S ^MAG(2005.87,9,0)="All 6 mth^^^^^^^^-6"
99 S ^MAG(2005.87,9,1)="^1^.05"
100 ;All Advance Directives^^CLIN^67^^^^^0
101 S DIK="^MAG(2005.87," D IXALL^DIK
102 D MES^XPDUTL("Default Public Filters added to IMAGE LIST FILTERS File.")
103 Q
Note: See TracBrowser for help on using the repository browser.