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

XU8P480.m

Go to the documentation of this file. 
  1. XU8P480 ;OAK_TKW - POST-INSTALL ROUTINE FOR XU*8*480 ;6/6/08  13:21
  1.  ;;8.0;KERNEL;**480**; July 10, 1995;Build 38
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified
  1. POST ; run post-init routine
  1.  ; Assign security key XUSNPIMTL to users with XUS NPI MENU option
  1.  N XUSIEN,XUSSIEN,XUSOIEN,XUSXREF,CNT,X,Y
  1.  K ^TMP("DIERR",$J)
  1.  D MES^XPDUTL("Assigning new security key XUSNPIMTL to users with XUS NPI MENU option...")
  1.  ; Find IEN of security key XUSNPIMTL and option XUS NPI MENU
  1.  S XUSSIEN=$$FIND1^DIC(19.1,,"QX","XUSNPIMTL","B")
  1.  I 'XUSSIEN!($D(^TMP("DIERR",$J))) D  Q
  1.  . D MES^XPDUTL("  **Security Key 'XUSNPIMTL' is not on your system")
  1.  . D POST2 Q
  1.  S XUSOIEN=$$FIND1^DIC(19,,"QX","XUS NPI MENU","B")
  1.  I 'XUSOIEN!($D(^TMP("DIERR",$J))) D  Q
  1.  . D MES^XPDUTL("  **OPTION 'XUS NPI MENU' is not on your system")
  1.  . D POST2 Q
  1.  ; Build list of users who hold the menu option 
  1.  K ^TMP($J,"XU8P480")
  1.  F XUSXREF="AD","AP" D
  1.  . F XUSIEN=0:0 S XUSIEN=$O(^VA(200,XUSXREF,XUSOIEN,XUSIEN)) Q:'XUSIEN  D
  1.  . . Q:'$D(^VA(200,XUSIEN,.1))
  1.  . . Q:'$$ACTIVE^XUSER(XUSIEN)
  1.  . . S ^TMP($J,"XU8P480",XUSIEN)=""
  1.  . . Q
  1.  . Q
  1.  I '$D(^TMP($J,"XU8P480")) D  Q
  1.  . D MES^XPDUTL("  *No users were found with access to the XUS NPI MENU option.")
  1.  . D MES^XPDUTL("  *Key 'XUSNPIMTL' was not assigned to any users.")
  1.  . D POST2 Q
  1.  ; Assign the key XUSNPIMTL to the users
  1.  N DIC,DA,DINUM
  1.  F XUSIEN=0:0 S XUSIEN=$O(^TMP($J,"XU8P480",XUSIEN)) Q:'XUSIEN  D
  1.  . Q:$D(^VA(200,XUSIEN,51,XUSSIEN))
  1.  . S DIC(0)="NLX",DIC("P")="200.051PA",DIC="^VA(200,XUSIEN,51,",DA(1)=XUSIEN
  1.  . S X=XUSSIEN,DINUM=X D FILE^DICN
  1.  . I Y>0 D MES^XPDUTL("  Key assigned to "_$P(^VA(200,XUSIEN,0),"^"))
  1.  . Q
  1.  K ^TMP($J,"XU8P480")
  1. POST2 ; Initialize new field 41.97 AUTHORIZES RELEASE OF NPI to 1 (Yes)
  1.  ; on all provider entries in file 200
  1.  D BMES^XPDUTL("Initializing AUTHORIZE RELEASE OF NPI field to 1 (Yes)...")
  1.  N XUSAUTH
  1.  S CNT=0
  1.  F XUSIEN=0:0 S XUSIEN=$O(^VA(200,XUSIEN)) Q:'XUSIEN  D
  1.  . ; Only update providers who have an NPI field.
  1.  . S X=$G(^VA(200,XUSIEN,"NPI"))
  1.  . S XUSAUTH=$P(X,"^",3)
  1.  . I $P(X,U)="",$O(^VA(200,XUSIEN,"NPISTATUS",0))'>0 D  Q
  1.  . . Q:XUSAUTH=""
  1.  . . S $P(^VA(200,XUSIEN,"NPI"),"^",3)=""
  1.  . . Q
  1.  . Q:XUSAUTH=1
  1.  . S $P(^VA(200,XUSIEN,"NPI"),"^",3)=1
  1.  . S CNT=CNT+1
  1.  . Q
  1.  D MES^XPDUTL("  AUTHORIZE RELEASE OF NPI field was set on "_CNT_" providers")
  1.  ; Rebuild list of taxonomy values for providers normally assigned NPIs.
  1.  D BMES^XPDUTL("Rebuilding temporary list of taxonomy values for providers who are")
  1.  D MES^XPDUTL(" normally assigned NPIs...")
  1.  K ^XTMP("NPIVALS")
  1.  S X=$$CHKGLOB^XUSNPIDA()
  1.  ; Add key XUSNPIMTL to the option XUS NPI MENU
  1.  N XUSMIEN,XUSFDA,XUSIEN
  1.  S XUSMIEN=$$LKOPT^XPDMENU("XUS NPI MENU")
  1.  I 'XUSMIEN D BMES^XPDUTL("****WARNING - Menu Option XUS NPI MENU is not on your system!!! *****") Q
  1.  K XUSFDA
  1.  S XUSFDA(19,XUSMIEN_",",3)="XUSNPIMTL"
  1.  D FILE^DIE("","XUSFDA")
  1.  K XUSFDA
  1.  ; Remove menu option that was added during testing. The AUTHORIZE USE OF NPI flag was
  1.  ; discontinued before patch XU*8*480 was released.
  1.  ; 
  1.  ; QUIT if option to edit AUTHORIZE USE OF NPI does not exist on this system.
  1.  S XUSIEN=$$FIND1^DIC(19,"","QX","XUS NPI EDIT AUTH TO RELEASE","B")
  1.  Q:'XUSIEN
  1.  ; Quit if option to edit AUTHORIZE USE OF NPI is not on the main NPI menu.
  1.  S X=$$FIND1^DIC(19.01,","_XUSMIEN_",","","XUS NPI EDIT AUTH TO RELEASE")
  1.  ; Delete the option to edit AUTHORIZE USE OF NPI from main menu, then delete the option.
  1.  I X D
  1.  . S XUSFDA(19.01,X_","_XUSMIEN_",",.01)="@"
  1.  . D FILE^DIE("","XUSFDA")
  1.  . Q
  1.  Q:'XUSIEN
  1.  K XUSFDA
  1.  S XUSFDA(19,XUSIEN_",",.01)="@"
  1.  D FILE^DIE("","XUSFDA")
  1.  Q
  1.  ;
  1.  ;