XU8P480 ;OAK_TKW - POST-INSTALL ROUTINE FOR XU*8*480 ;6/6/08 13:21
;;8.0;KERNEL;**480**; July 10, 1995;Build 38
;;Per VHA Directive 2004-038, this routine should not be modified
POST ; run post-init routine
; Assign security key XUSNPIMTL to users with XUS NPI MENU option
N XUSIEN,XUSSIEN,XUSOIEN,XUSXREF,CNT,X,Y
K ^TMP("DIERR",$J)
D MES^XPDUTL("Assigning new security key XUSNPIMTL to users with XUS NPI MENU option...")
; Find IEN of security key XUSNPIMTL and option XUS NPI MENU
S XUSSIEN=$$FIND1^DIC(19.1,,"QX","XUSNPIMTL","B")
I 'XUSSIEN!($D(^TMP("DIERR",$J))) D Q
. D MES^XPDUTL(" **Security Key 'XUSNPIMTL' is not on your system")
. D POST2 Q
S XUSOIEN=$$FIND1^DIC(19,,"QX","XUS NPI MENU","B")
I 'XUSOIEN!($D(^TMP("DIERR",$J))) D Q
. D MES^XPDUTL(" **OPTION 'XUS NPI MENU' is not on your system")
. D POST2 Q
; Build list of users who hold the menu option
K ^TMP($J,"XU8P480")
F XUSXREF="AD","AP" D
. F XUSIEN=0:0 S XUSIEN=$O(^VA(200,XUSXREF,XUSOIEN,XUSIEN)) Q:'XUSIEN D
. . Q:'$D(^VA(200,XUSIEN,.1))
. . Q:'$$ACTIVE^XUSER(XUSIEN)
. . S ^TMP($J,"XU8P480",XUSIEN)=""
. . Q
. Q
I '$D(^TMP($J,"XU8P480")) D Q
. D MES^XPDUTL(" *No users were found with access to the XUS NPI MENU option.")
. D MES^XPDUTL(" *Key 'XUSNPIMTL' was not assigned to any users.")
. D POST2 Q
; Assign the key XUSNPIMTL to the users
N DIC,DA,DINUM
F XUSIEN=0:0 S XUSIEN=$O(^TMP($J,"XU8P480",XUSIEN)) Q:'XUSIEN D
. Q:$D(^VA(200,XUSIEN,51,XUSSIEN))
. S DIC(0)="NLX",DIC("P")="200.051PA",DIC="^VA(200,XUSIEN,51,",DA(1)=XUSIEN
. S X=XUSSIEN,DINUM=X D FILE^DICN
. I Y>0 D MES^XPDUTL(" Key assigned to "_$P(^VA(200,XUSIEN,0),"^"))
. Q
K ^TMP($J,"XU8P480")
POST2 ; Initialize new field 41.97 AUTHORIZES RELEASE OF NPI to 1 (Yes)
; on all provider entries in file 200
D BMES^XPDUTL("Initializing AUTHORIZE RELEASE OF NPI field to 1 (Yes)...")
N XUSAUTH
S CNT=0
F XUSIEN=0:0 S XUSIEN=$O(^VA(200,XUSIEN)) Q:'XUSIEN D
. ; Only update providers who have an NPI field.
. S X=$G(^VA(200,XUSIEN,"NPI"))
. S XUSAUTH=$P(X,"^",3)
. I $P(X,U)="",$O(^VA(200,XUSIEN,"NPISTATUS",0))'>0 D Q
. . Q:XUSAUTH=""
. . S $P(^VA(200,XUSIEN,"NPI"),"^",3)=""
. . Q
. Q:XUSAUTH=1
. S $P(^VA(200,XUSIEN,"NPI"),"^",3)=1
. S CNT=CNT+1
. Q
D MES^XPDUTL(" AUTHORIZE RELEASE OF NPI field was set on "_CNT_" providers")
; Rebuild list of taxonomy values for providers normally assigned NPIs.
D BMES^XPDUTL("Rebuilding temporary list of taxonomy values for providers who are")
D MES^XPDUTL(" normally assigned NPIs...")
K ^XTMP("NPIVALS")
S X=$$CHKGLOB^XUSNPIDA()
; Add key XUSNPIMTL to the option XUS NPI MENU
N XUSMIEN,XUSFDA,XUSIEN
S XUSMIEN=$$LKOPT^XPDMENU("XUS NPI MENU")
I 'XUSMIEN D BMES^XPDUTL("****WARNING - Menu Option XUS NPI MENU is not on your system!!! *****") Q
K XUSFDA
S XUSFDA(19,XUSMIEN_",",3)="XUSNPIMTL"
D FILE^DIE("","XUSFDA")
K XUSFDA
; Remove menu option that was added during testing. The AUTHORIZE USE OF NPI flag was
; discontinued before patch XU*8*480 was released.
;
; QUIT if option to edit AUTHORIZE USE OF NPI does not exist on this system.
S XUSIEN=$$FIND1^DIC(19,"","QX","XUS NPI EDIT AUTH TO RELEASE","B")
Q:'XUSIEN
; Quit if option to edit AUTHORIZE USE OF NPI is not on the main NPI menu.
S X=$$FIND1^DIC(19.01,","_XUSMIEN_",","","XUS NPI EDIT AUTH TO RELEASE")
; Delete the option to edit AUTHORIZE USE OF NPI from main menu, then delete the option.
I X D
. S XUSFDA(19.01,X_","_XUSMIEN_",",.01)="@"
. D FILE^DIE("","XUSFDA")
. Q
Q:'XUSIEN
K XUSFDA
S XUSFDA(19,XUSIEN_",",.01)="@"
D FILE^DIE("","XUSFDA")
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P480 3682 printed Dec 13, 2024@02:07:51 Page 2
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
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
POST ; run post-init routine
+1 ; Assign security key XUSNPIMTL to users with XUS NPI MENU option
+2 NEW XUSIEN,XUSSIEN,XUSOIEN,XUSXREF,CNT,X,Y
+3 KILL ^TMP("DIERR",$JOB)
+4 DO MES^XPDUTL("Assigning new security key XUSNPIMTL to users with XUS NPI MENU option...")
+5 ; Find IEN of security key XUSNPIMTL and option XUS NPI MENU
+6 SET XUSSIEN=$$FIND1^DIC(19.1,,"QX","XUSNPIMTL","B")
+7 IF 'XUSSIEN!($DATA(^TMP("DIERR",$JOB)))
Begin DoDot:1
+8 DO MES^XPDUTL(" **Security Key 'XUSNPIMTL' is not on your system")
+9 DO POST2
QUIT
End DoDot:1
QUIT
+10 SET XUSOIEN=$$FIND1^DIC(19,,"QX","XUS NPI MENU","B")
+11 IF 'XUSOIEN!($DATA(^TMP("DIERR",$JOB)))
Begin DoDot:1
+12 DO MES^XPDUTL(" **OPTION 'XUS NPI MENU' is not on your system")
+13 DO POST2
QUIT
End DoDot:1
QUIT
+14 ; Build list of users who hold the menu option
+15 KILL ^TMP($JOB,"XU8P480")
+16 FOR XUSXREF="AD","AP"
Begin DoDot:1
+17 FOR XUSIEN=0:0
SET XUSIEN=$ORDER(^VA(200,XUSXREF,XUSOIEN,XUSIEN))
if 'XUSIEN
QUIT
Begin DoDot:2
+18 if '$DATA(^VA(200,XUSIEN,.1))
QUIT
+19 if '$$ACTIVE^XUSER(XUSIEN)
QUIT
+20 SET ^TMP($JOB,"XU8P480",XUSIEN)=""
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 IF '$DATA(^TMP($JOB,"XU8P480"))
Begin DoDot:1
+24 DO MES^XPDUTL(" *No users were found with access to the XUS NPI MENU option.")
+25 DO MES^XPDUTL(" *Key 'XUSNPIMTL' was not assigned to any users.")
+26 DO POST2
QUIT
End DoDot:1
QUIT
+27 ; Assign the key XUSNPIMTL to the users
+28 NEW DIC,DA,DINUM
+29 FOR XUSIEN=0:0
SET XUSIEN=$ORDER(^TMP($JOB,"XU8P480",XUSIEN))
if 'XUSIEN
QUIT
Begin DoDot:1
+30 if $DATA(^VA(200,XUSIEN,51,XUSSIEN))
QUIT
+31 SET DIC(0)="NLX"
SET DIC("P")="200.051PA"
SET DIC="^VA(200,XUSIEN,51,"
SET DA(1)=XUSIEN
+32 SET X=XUSSIEN
SET DINUM=X
DO FILE^DICN
+33 IF Y>0
DO MES^XPDUTL(" Key assigned to "_$PIECE(^VA(200,XUSIEN,0),"^"))
+34 QUIT
End DoDot:1
+35 KILL ^TMP($JOB,"XU8P480")
POST2 ; Initialize new field 41.97 AUTHORIZES RELEASE OF NPI to 1 (Yes)
+1 ; on all provider entries in file 200
+2 DO BMES^XPDUTL("Initializing AUTHORIZE RELEASE OF NPI field to 1 (Yes)...")
+3 NEW XUSAUTH
+4 SET CNT=0
+5 FOR XUSIEN=0:0
SET XUSIEN=$ORDER(^VA(200,XUSIEN))
if 'XUSIEN
QUIT
Begin DoDot:1
+6 ; Only update providers who have an NPI field.
+7 SET X=$GET(^VA(200,XUSIEN,"NPI"))
+8 SET XUSAUTH=$PIECE(X,"^",3)
+9 IF $PIECE(X,U)=""
IF $ORDER(^VA(200,XUSIEN,"NPISTATUS",0))'>0
Begin DoDot:2
+10 if XUSAUTH=""
QUIT
+11 SET $PIECE(^VA(200,XUSIEN,"NPI"),"^",3)=""
+12 QUIT
End DoDot:2
QUIT
+13 if XUSAUTH=1
QUIT
+14 SET $PIECE(^VA(200,XUSIEN,"NPI"),"^",3)=1
+15 SET CNT=CNT+1
+16 QUIT
End DoDot:1
+17 DO MES^XPDUTL(" AUTHORIZE RELEASE OF NPI field was set on "_CNT_" providers")
+18 ; Rebuild list of taxonomy values for providers normally assigned NPIs.
+19 DO BMES^XPDUTL("Rebuilding temporary list of taxonomy values for providers who are")
+20 DO MES^XPDUTL(" normally assigned NPIs...")
+21 KILL ^XTMP("NPIVALS")
+22 SET X=$$CHKGLOB^XUSNPIDA()
+23 ; Add key XUSNPIMTL to the option XUS NPI MENU
+24 NEW XUSMIEN,XUSFDA,XUSIEN
+25 SET XUSMIEN=$$LKOPT^XPDMENU("XUS NPI MENU")
+26 IF 'XUSMIEN
DO BMES^XPDUTL("****WARNING - Menu Option XUS NPI MENU is not on your system!!! *****")
QUIT
+27 KILL XUSFDA
+28 SET XUSFDA(19,XUSMIEN_",",3)="XUSNPIMTL"
+29 DO FILE^DIE("","XUSFDA")
+30 KILL XUSFDA
+31 ; Remove menu option that was added during testing. The AUTHORIZE USE OF NPI flag was
+32 ; discontinued before patch XU*8*480 was released.
+33 ;
+34 ; QUIT if option to edit AUTHORIZE USE OF NPI does not exist on this system.
+35 SET XUSIEN=$$FIND1^DIC(19,"","QX","XUS NPI EDIT AUTH TO RELEASE","B")
+36 if 'XUSIEN
QUIT
+37 ; Quit if option to edit AUTHORIZE USE OF NPI is not on the main NPI menu.
+38 SET X=$$FIND1^DIC(19.01,","_XUSMIEN_",","","XUS NPI EDIT AUTH TO RELEASE")
+39 ; Delete the option to edit AUTHORIZE USE OF NPI from main menu, then delete the option.
+40 IF X
Begin DoDot:1
+41 SET XUSFDA(19.01,X_","_XUSMIEN_",",.01)="@"
+42 DO FILE^DIE("","XUSFDA")
+43 QUIT
End DoDot:1
+44 if 'XUSIEN
QUIT
+45 KILL XUSFDA
+46 SET XUSFDA(19,XUSIEN_",",.01)="@"
+47 DO FILE^DIE("","XUSFDA")
+48 QUIT
+49 ;
+50 ;
