source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTU9.m@ 1437

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

initial load of FOIAVistA 6/30/08 version

File size: 6.6 KB
Line 
1MAGGTU9 ;WOIFO/LB/GEK - Imaging utilities assign key
2 ;;3.0;IMAGING;**8,59**;Nov 27, 2007;Build 20
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20CHKKEY ;
21 N NOGIVE
22 S NOGIVE=1
23GIVEKEY ;Give MAGDISP CLIN key to all MAG WINDOWS option holders
24 ; that have neither MAGDISP CLIN nor MAGDISP ADMIN
25 ; Find the menu option's IEN
26 N MKEYC,MKEYA,ERR,OPT,MAGUSER,I,KEYCLIN,KEYADMIN,KEYCT,KEYECT,XCT
27 N KEYHASC,KEYHASA,KEYHASB,KEYNONE,SP,LSP
28 N UCT,UTOT,OPTACC,MDOT,UDISCT
29 ; This could be made Generic if ever a need, to search for users
30 ; withour either key, and assigned those users the first (KEYCLIN)
31 S KEYCLIN="MAGDISP CLIN"
32 S KEYADMIN="MAGDISP ADMIN"
33 S KEYCT=0 ; count of number of users that were assigned the key.
34 S KEYECT=0 ; count of number of errors during the assignment.
35 S KEYHASC=0 ; count of number of users that already have key Clin
36 S KEYHASA=0 ; count of number of users that already have key Admin
37 S KEYHASB=0 ; count of number of users that Have Both keys
38 S KEYNONE=0 ; count of Users that have Neither Key.
39 S OPTACC=0 ; count of users with access to MAG WINDOWS.
40 S UDISCT=0 ; count of Disabled Users Skipped.
41 S MDOT=10000 ; print '.' to screen to show progress.
42 S UCT=0 ; user count. for progress
43 S UTOT=$P(^VA(200,0),"^",4)
44 ;
45 I $G(NOGIVE) D
46 . D MES^XPDUTL("Checking for users that have access to Option : "_"MAG WINDOWS")
47 . D MES^XPDUTL(" but do not have either '"_KEYCLIN_"' or '"_KEYADMIN_"' Keys")
48 . D MES^XPDUTL(" Disabled users (DISUSER=1) are skipped, they are not checked.")
49 . Q
50 E D MES^XPDUTL("Assigning "_KEYCLIN_" to all users with access to Option : "_"MAG WINDOWS")
51 D MES^XPDUTL(" ")
52 S OPT=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","ERR")
53 I OPT="" D MES^XPDUTL("ERROR ",$G(ERR("DIERR",1,"TEXT",1))) Q
54 I OPT=0 D MES^XPDUTL("MAG WINDOWS wasn't found in Option File") Q
55 ; Lookup the security key
56 S MKEYC=$$LKUP^XPDKEY(KEYCLIN)
57 S MKEYA=$$LKUP^XPDKEY(KEYADMIN)
58 I ('MKEYC)!('MKEYA) D MES^XPDUTL("ERROR: Imaging Display Keys are not defined at this site") Q
59 ; Check all Users at site to see if they don't have either Clin or Admin
60 D MES^XPDUTL("Checking users...")
61 D MES^XPDUTL(" ")
62 S I=0 F S I=$O(^VA(200,I)) Q:'I D
63 . I $$GET1^DIQ(200,I,7,"E")]"" S UDISCT=UDISCT+1 Q
64 . S UCT=UCT+1 I UCT>MDOT S MDOT=MDOT+10000 D MES^XPDUTL(UCT_" of "_UTOT_" users checked...")
65 . I (($$ACCESS^XQCHK(I,OPT))>0) S OPTACC=OPTACC+1 D C(I)
66 . Q
67 S SP=" "
68 S LSP=$L(UTOT)+3
69 D MES^XPDUTL(" ")
70 I $G(NOGIVE) D
71 . D MES^XPDUTL($E(SP,1,LSP-$L(OPTACC))_OPTACC_" of "_UTOT_" Users have access to option MAG WINDOWS.")
72 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASB))_KEYHASB_" Users have Both Keys ")
73 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASC))_KEYHASC_" Users only have "_KEYCLIN_" key")
74 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASA))_KEYHASA_" Users only have "_KEYADMIN_" key")
75 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYNONE))_KEYNONE_" Users have neither Key")
76 . I KEYECT>0 D MES^XPDUTL(KEYECT_" Errors during Key Assignment. See install log for details")
77 . Q
78 I '$G(NOGIVE) D
79 . D MES^XPDUTL($E(SP,1,LSP-$L(OPTACC))_OPTACC_" of "_UTOT_" Users have access to option MAG WINDOWS.")
80 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASB))_KEYHASB_" Users already have Both Keys ")
81 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASC))_KEYHASC_" Users have Only Key "_KEYCLIN)
82 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASA))_KEYHASA_" Users have Only Key "_KEYADMIN)
83 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYCT))_KEYCT_" Users were assigned key: "_KEYCLIN)
84 . D MES^XPDUTL("Assignment Complete.")
85 . I KEYECT>0 D MES^XPDUTL(KEYECT_" Errors during Key Assignment. See install log for details")
86 . Q
87 Q
88C(USER) ;
89 ; check KEY for USER
90 N DO,D1,MFDA,ZC,ZA,MIEN
91 ; check to see if they have the Clin key
92 S ZC=$$FIND1^DIC(200.051,","_USER_",","",KEYCLIN)
93 I ZC="" D Q
94 . D MES^XPDUTL("ERROR Validating that user ("_USER_") has Key "_KEYCLIN)
95 . S KEYECT=KEYECT+1
96 . Q
97 ; check to see if they have the Admin key
98 S ZA=$$FIND1^DIC(200.051,","_USER_",","",KEYADMIN)
99 I ZA="" D Q
100 . D MES^XPDUTL("ERROR Validating that user ("_USER_") has Key "_KEYADMIN)
101 . S KEYECT=KEYECT+1
102 . Q
103 I ((+ZC)&(+ZA)) S KEYHASB=KEYHASB+1 Q
104 I +ZC S KEYHASC=KEYHASC+1 Q
105 I +ZA S KEYHASA=KEYHASA+1 Q
106 S KEYNONE=KEYNONE+1
107 I $G(NOGIVE) D Q
108 . D MES^XPDUTL("User: "_$P($G(^VA(200,USER,0)),"^")_" has neither Key")
109 . Q
110 S MFDA(200.051,"+1,"_USER_",",.01)=MKEYC
111 S MFDA(200.051,"+1,"_USER_",",1)=DUZ
112 S MFDA(200.051,"+1,"_USER_",",2)=DT
113 S MIEN(1)=MKEYC_","
114 D UPDATE^DIE("","MFDA","MIEN")
115 I $D(DIERR) D Q
116 . D MES^XPDUTL("ERROR Assigning Key ("_KEYCLIN_") to user ("_USER_")")
117 . S KEYECT=KEYECT+1
118 . D CLEAN^DILF
119 . Q
120 S KEYCT=KEYCT+1
121 D CLEAN^DILF
122 Q
123FLT ; Create a Few Public Filters as a default for sites.
124 ; Only create new public filters if file is empty.
125 N DIK
126 I +$P(^MAG(2005.87,0),"^",3) D Q
127 . D MES^XPDUTL("The IMAGE LIST FILTERS File is not empty,")
128 . D MES^XPDUTL(" Default Public Filters were not installed.")
129 . Q
130 S ^MAG(2005.87,1,0)="Rad All^RAD^CLIN^^^^^^0"
131 S ^MAG(2005.87,1,1)="^1^.05"
132 S ^MAG(2005.87,2,0)="Clin All^^CLIN^^^^^^0"
133 S ^MAG(2005.87,2,1)="^1^.05"
134 S ^MAG(2005.87,3,0)="Admin All^^ADMIN^^^^^^0"
135 S ^MAG(2005.87,3,1)="^1^.05"
136 S ^MAG(2005.87,4,0)="Clin 2 yr^^CLIN^^^^^^-24"
137 S ^MAG(2005.87,4,1)="^1^.05"
138 S ^MAG(2005.87,5,0)="Admin 10-10EZ All^^ADMIN^46,^^^^^0"
139 S ^MAG(2005.87,5,1)="^1^.05"
140 S ^MAG(2005.87,6,0)="Adv Directives^^CLIN^67^^^^^0"
141 S ^MAG(2005.87,6,1)="^1^.05"
142 S ^MAG(2005.87,7,0)="All^^^^^^^^0"
143 S ^MAG(2005.87,7,1)="^1^.05"
144 S ^MAG(2005.87,8,0)="All 2 yr^^^^^^^^-24"
145 S ^MAG(2005.87,8,1)="^1^.05"
146 S ^MAG(2005.87,9,0)="All 6 mth^^^^^^^^-6"
147 S ^MAG(2005.87,9,1)="^1^.05"
148 ;All Advance Directives^^CLIN^67^^^^^0
149 S DIK="^MAG(2005.87," D IXALL^DIK
150 D MES^XPDUTL("Default Public Filters added to IMAGE LIST FILTERS File.")
151 Q
Note: See TracBrowser for help on using the repository browser.