Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU9.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU9.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU9.m
r613 r623 1 MAGGTU9 ;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 20 CHKKEY ; 21 N NOGIVE 22 S NOGIVE=1 23 GIVEKEY ;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 88 C(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 123 FLT ; 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 1 MAGGTU9 ;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 19 EN ;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 51 GIVEKEY(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 75 FLT ; 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 TracChangeset
for help on using the changeset viewer.
