source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XU8P480.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1XU8P480 ;OAK_TKW - POST-INSTALL ROUTINE FOR XU*8*480 ;6/6/08 13:21
2 ;;8.0;KERNEL;**480**; July 10, 1995;Build 38
3 ;;Per VHA Directive 2004-038, this routine should not be modified
4POST ; run post-init routine
5 ; Assign security key XUSNPIMTL to users with XUS NPI MENU option
6 N XUSIEN,XUSSIEN,XUSOIEN,XUSXREF,CNT,X,Y
7 K ^TMP("DIERR",$J)
8 D MES^XPDUTL("Assigning new security key XUSNPIMTL to users with XUS NPI MENU option...")
9 ; Find IEN of security key XUSNPIMTL and option XUS NPI MENU
10 S XUSSIEN=$$FIND1^DIC(19.1,,"QX","XUSNPIMTL","B")
11 I 'XUSSIEN!($D(^TMP("DIERR",$J))) D Q
12 . D MES^XPDUTL(" **Security Key 'XUSNPIMTL' is not on your system")
13 . D POST2 Q
14 S XUSOIEN=$$FIND1^DIC(19,,"QX","XUS NPI MENU","B")
15 I 'XUSOIEN!($D(^TMP("DIERR",$J))) D Q
16 . D MES^XPDUTL(" **OPTION 'XUS NPI MENU' is not on your system")
17 . D POST2 Q
18 ; Build list of users who hold the menu option
19 K ^TMP($J,"XU8P480")
20 F XUSXREF="AD","AP" D
21 . F XUSIEN=0:0 S XUSIEN=$O(^VA(200,XUSXREF,XUSOIEN,XUSIEN)) Q:'XUSIEN D
22 . . Q:'$D(^VA(200,XUSIEN,.1))
23 . . Q:'$$ACTIVE^XUSER(XUSIEN)
24 . . S ^TMP($J,"XU8P480",XUSIEN)=""
25 . . Q
26 . Q
27 I '$D(^TMP($J,"XU8P480")) D Q
28 . D MES^XPDUTL(" *No users were found with access to the XUS NPI MENU option.")
29 . D MES^XPDUTL(" *Key 'XUSNPIMTL' was not assigned to any users.")
30 . D POST2 Q
31 ; Assign the key XUSNPIMTL to the users
32 N DIC,DA,DINUM
33 F XUSIEN=0:0 S XUSIEN=$O(^TMP($J,"XU8P480",XUSIEN)) Q:'XUSIEN D
34 . Q:$D(^VA(200,XUSIEN,51,XUSSIEN))
35 . S DIC(0)="NLX",DIC("P")="200.051PA",DIC="^VA(200,XUSIEN,51,",DA(1)=XUSIEN
36 . S X=XUSSIEN,DINUM=X D FILE^DICN
37 . I Y>0 D MES^XPDUTL(" Key assigned to "_$P(^VA(200,XUSIEN,0),"^"))
38 . Q
39 K ^TMP($J,"XU8P480")
40POST2 ; Initialize new field 41.97 AUTHORIZES RELEASE OF NPI to 1 (Yes)
41 ; on all provider entries in file 200
42 D BMES^XPDUTL("Initializing AUTHORIZE RELEASE OF NPI field to 1 (Yes)...")
43 N XUSAUTH
44 S CNT=0
45 F XUSIEN=0:0 S XUSIEN=$O(^VA(200,XUSIEN)) Q:'XUSIEN D
46 . ; Only update providers who have an NPI field.
47 . S X=$G(^VA(200,XUSIEN,"NPI"))
48 . S XUSAUTH=$P(X,"^",3)
49 . I $P(X,U)="",$O(^VA(200,XUSIEN,"NPISTATUS",0))'>0 D Q
50 . . Q:XUSAUTH=""
51 . . S $P(^VA(200,XUSIEN,"NPI"),"^",3)=""
52 . . Q
53 . Q:XUSAUTH=1
54 . S $P(^VA(200,XUSIEN,"NPI"),"^",3)=1
55 . S CNT=CNT+1
56 . Q
57 D MES^XPDUTL(" AUTHORIZE RELEASE OF NPI field was set on "_CNT_" providers")
58 ; Rebuild list of taxonomy values for providers normally assigned NPIs.
59 D BMES^XPDUTL("Rebuilding temporary list of taxonomy values for providers who are")
60 D MES^XPDUTL(" normally assigned NPIs...")
61 K ^XTMP("NPIVALS")
62 S X=$$CHKGLOB^XUSNPIDA()
63 ; Add key XUSNPIMTL to the option XUS NPI MENU
64 N XUSMIEN,XUSFDA,XUSIEN
65 S XUSMIEN=$$LKOPT^XPDMENU("XUS NPI MENU")
66 I 'XUSMIEN D BMES^XPDUTL("****WARNING - Menu Option XUS NPI MENU is not on your system!!! *****") Q
67 K XUSFDA
68 S XUSFDA(19,XUSMIEN_",",3)="XUSNPIMTL"
69 D FILE^DIE("","XUSFDA")
70 K XUSFDA
71 ; Remove menu option that was added during testing. The AUTHORIZE USE OF NPI flag was
72 ; discontinued before patch XU*8*480 was released.
73 ;
74 ; QUIT if option to edit AUTHORIZE USE OF NPI does not exist on this system.
75 S XUSIEN=$$FIND1^DIC(19,"","QX","XUS NPI EDIT AUTH TO RELEASE","B")
76 Q:'XUSIEN
77 ; Quit if option to edit AUTHORIZE USE OF NPI is not on the main NPI menu.
78 S X=$$FIND1^DIC(19.01,","_XUSMIEN_",","","XUS NPI EDIT AUTH TO RELEASE")
79 ; Delete the option to edit AUTHORIZE USE OF NPI from main menu, then delete the option.
80 I X D
81 . S XUSFDA(19.01,X_","_XUSMIEN_",",.01)="@"
82 . D FILE^DIE("","XUSFDA")
83 . Q
84 Q:'XUSIEN
85 K XUSFDA
86 S XUSFDA(19,XUSIEN_",",.01)="@"
87 D FILE^DIE("","XUSFDA")
88 Q
89 ;
90 ;
Note: See TracBrowser for help on using the repository browser.