| 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
 | 
|---|