Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGGTU9

MAGGTU9.m

Go to the documentation of this file. 
  1. MAGGTU9 ;WOIFO/LB/GEK - Imaging utilities assign key
  1.  ;;3.0;IMAGING;**8,59**;Nov 27, 2007;Build 20
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; |                                                               |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1. CHKKEY ;
  1.  N NOGIVE
  1.  S NOGIVE=1
  1. GIVEKEY ;Give MAGDISP CLIN key to all MAG WINDOWS option holders
  1.  ; that have neither MAGDISP CLIN nor MAGDISP ADMIN
  1.  ;   Find the menu option's IEN
  1.  N MKEYC,MKEYA,ERR,OPT,MAGUSER,I,KEYCLIN,KEYADMIN,KEYCT,KEYECT,XCT
  1.  N KEYHASC,KEYHASA,KEYHASB,KEYNONE,SP,LSP
  1.  N UCT,UTOT,OPTACC,MDOT,UDISCT
  1.  ; This could be made Generic if ever a need, to search for users 
  1.  ; withour either key, and assigned those users the first (KEYCLIN)
  1.  S KEYCLIN="MAGDISP CLIN"
  1.  S KEYADMIN="MAGDISP ADMIN"
  1.  S KEYCT=0 ; count of number of users that were assigned the key.
  1.  S KEYECT=0 ; count of number of errors during the assignment.
  1.  S KEYHASC=0 ; count of number of users that already have key Clin
  1.  S KEYHASA=0 ; count of number of users that already have key Admin
  1.  S KEYHASB=0 ; count of number of users that Have Both keys
  1.  S KEYNONE=0 ; count of Users that have Neither Key.
  1.  S OPTACC=0 ; count of users with access to MAG WINDOWS.
  1.  S UDISCT=0 ; count of Disabled Users Skipped.
  1.  S MDOT=10000 ; print '.' to screen to show progress.
  1.  S UCT=0 ; user count. for progress
  1.  S UTOT=$P(^VA(200,0),"^",4)
  1.  ;
  1.  I $G(NOGIVE) D 
  1.  . D MES^XPDUTL("Checking for users that have access to Option : "_"MAG WINDOWS")
  1.  . D MES^XPDUTL("  but do not have either '"_KEYCLIN_"' or '"_KEYADMIN_"' Keys")
  1.  . D MES^XPDUTL("  Disabled users (DISUSER=1) are skipped, they are not checked.")
  1.  . Q
  1.  E  D MES^XPDUTL("Assigning "_KEYCLIN_" to all users with access to Option : "_"MAG WINDOWS")
  1.  D MES^XPDUTL("  ")
  1.  S OPT=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","ERR")
  1.  I OPT="" D MES^XPDUTL("ERROR ",$G(ERR("DIERR",1,"TEXT",1))) Q
  1.  I OPT=0 D MES^XPDUTL("MAG WINDOWS wasn't found in Option File") Q
  1.  ;   Lookup the security key
  1.  S MKEYC=$$LKUP^XPDKEY(KEYCLIN)
  1.  S MKEYA=$$LKUP^XPDKEY(KEYADMIN)
  1.  I ('MKEYC)!('MKEYA) D MES^XPDUTL("ERROR: Imaging Display Keys are not defined at this site") Q
  1.  ;   Check all Users at site to see if they don't have either Clin or Admin
  1.  D MES^XPDUTL("Checking users...")
  1.  D MES^XPDUTL(" ")
  1.  S I=0 F  S I=$O(^VA(200,I)) Q:'I  D
  1.  . I $$GET1^DIQ(200,I,7,"E")]"" S UDISCT=UDISCT+1 Q
  1.  . S UCT=UCT+1 I UCT>MDOT S MDOT=MDOT+10000 D MES^XPDUTL(UCT_" of "_UTOT_" users checked...")
  1.  . I (($$ACCESS^XQCHK(I,OPT))>0) S OPTACC=OPTACC+1 D C(I)
  1.  . Q
  1.  S SP="          "
  1.  S LSP=$L(UTOT)+3
  1.  D MES^XPDUTL("   ")
  1.  I $G(NOGIVE) D
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(OPTACC))_OPTACC_" of "_UTOT_" Users have access to option MAG WINDOWS.")
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASB))_KEYHASB_" Users have Both Keys ")
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASC))_KEYHASC_" Users only have "_KEYCLIN_" key")
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASA))_KEYHASA_" Users only have "_KEYADMIN_" key")
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(KEYNONE))_KEYNONE_" Users have neither Key")
  1.  . I KEYECT>0 D MES^XPDUTL(KEYECT_" Errors during Key Assignment. See install log for details")
  1.  . Q
  1.  I '$G(NOGIVE) D
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(OPTACC))_OPTACC_" of "_UTOT_" Users have access to option MAG WINDOWS.")
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASB))_KEYHASB_" Users already have Both Keys ")
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASC))_KEYHASC_" Users have Only Key "_KEYCLIN)
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASA))_KEYHASA_" Users have Only Key "_KEYADMIN)
  1.  . D MES^XPDUTL($E(SP,1,LSP-$L(KEYCT))_KEYCT_" Users were assigned key: "_KEYCLIN)
  1.  . D MES^XPDUTL("Assignment Complete.")
  1.  . I KEYECT>0 D MES^XPDUTL(KEYECT_" Errors during Key Assignment. See install log for details")
  1.  . Q
  1.  Q
  1. C(USER) ;
  1.  ; check KEY for USER
  1.  N DO,D1,MFDA,ZC,ZA,MIEN
  1.  ; check to see if they have the Clin key
  1.  S ZC=$$FIND1^DIC(200.051,","_USER_",","",KEYCLIN)
  1.  I ZC="" D  Q
  1.  . D MES^XPDUTL("ERROR Validating that user ("_USER_") has Key "_KEYCLIN)
  1.  . S KEYECT=KEYECT+1
  1.  . Q
  1.  ; check to see if they have the Admin key
  1.  S ZA=$$FIND1^DIC(200.051,","_USER_",","",KEYADMIN)
  1.  I ZA="" D  Q
  1.  . D MES^XPDUTL("ERROR Validating that user ("_USER_") has Key "_KEYADMIN)
  1.  . S KEYECT=KEYECT+1
  1.  . Q
  1.  I ((+ZC)&(+ZA)) S KEYHASB=KEYHASB+1 Q
  1.  I +ZC S KEYHASC=KEYHASC+1 Q
  1.  I +ZA S KEYHASA=KEYHASA+1 Q
  1.  S KEYNONE=KEYNONE+1
  1.  I $G(NOGIVE) D  Q
  1.  . D MES^XPDUTL("User: "_$P($G(^VA(200,USER,0)),"^")_" has neither Key")
  1.  . Q
  1.  S MFDA(200.051,"+1,"_USER_",",.01)=MKEYC
  1.  S MFDA(200.051,"+1,"_USER_",",1)=DUZ
  1.  S MFDA(200.051,"+1,"_USER_",",2)=DT
  1.  S MIEN(1)=MKEYC_","
  1.  D UPDATE^DIE("","MFDA","MIEN")
  1.  I $D(DIERR) D  Q
  1.  . D MES^XPDUTL("ERROR Assigning Key ("_KEYCLIN_") to user ("_USER_")")
  1.  . S KEYECT=KEYECT+1
  1.  . D CLEAN^DILF
  1.  . Q
  1.  S KEYCT=KEYCT+1
  1.  D CLEAN^DILF
  1.  Q
  1. FLT ;  Create a Few Public Filters as a default for sites.
  1.  ;  Only create new public filters if file is empty.
  1.  N DIK
  1.  I +$P(^MAG(2005.87,0),"^",3) D  Q
  1.  . D MES^XPDUTL("The IMAGE LIST FILTERS File is not empty,")
  1.  . D MES^XPDUTL("  Default Public Filters were not installed.")
  1.  . Q
  1.  S ^MAG(2005.87,1,0)="Rad All^RAD^CLIN^^^^^^0"
  1.  S ^MAG(2005.87,1,1)="^1^.05"
  1.  S ^MAG(2005.87,2,0)="Clin All^^CLIN^^^^^^0"
  1.  S ^MAG(2005.87,2,1)="^1^.05"
  1.  S ^MAG(2005.87,3,0)="Admin All^^ADMIN^^^^^^0"
  1.  S ^MAG(2005.87,3,1)="^1^.05"
  1.  S ^MAG(2005.87,4,0)="Clin 2 yr^^CLIN^^^^^^-24"
  1.  S ^MAG(2005.87,4,1)="^1^.05"
  1.  S ^MAG(2005.87,5,0)="Admin 10-10EZ All^^ADMIN^46,^^^^^0"
  1.  S ^MAG(2005.87,5,1)="^1^.05"
  1.  S ^MAG(2005.87,6,0)="Adv Directives^^CLIN^67^^^^^0"
  1.  S ^MAG(2005.87,6,1)="^1^.05"
  1.  S ^MAG(2005.87,7,0)="All^^^^^^^^0"
  1.  S ^MAG(2005.87,7,1)="^1^.05"
  1.  S ^MAG(2005.87,8,0)="All 2 yr^^^^^^^^-24"
  1.  S ^MAG(2005.87,8,1)="^1^.05"
  1.  S ^MAG(2005.87,9,0)="All 6 mth^^^^^^^^-6"
  1.  S ^MAG(2005.87,9,1)="^1^.05"
  1.  ;All Advance Directives^^CLIN^67^^^^^0
  1.  S DIK="^MAG(2005.87," D IXALL^DIK
  1.  D MES^XPDUTL("Default Public Filters added to IMAGE LIST FILTERS File.")
  1.  Q