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

DVBCP238.m

Go to the documentation of this file.
  1. DVBCP238 ;ALB/FSB - PATCH DVBA*2.7*238 POST-INSTALL ROUTINE; MAR 29, 2022@17:00
  1. ;;2.7;AMIE;**238**;Apr 10, 1995;Build 16
  1. ;
  1. ; Reference to XUS KEY CHECK in ICR #6286
  1. ; Reference to XUS ALLKEYS in ICR #6287
  1. ;
  1. Q
  1. SECKEY ;
  1. ;
  1. N DVBKEYNO,DVBIEN,DVBMNU,DVBSTOP1,DVBNAME,DVBOPIEN,DVBPRDUZ,DVBMSG,DVBERR,DVBKYIEN,DVBPER,DVBTODAY,X,DVBZZ
  1. ;
  1. S DVBZZ="" D OWNSKEY^XUSRB(.DVBZZ,"XUMGR",DUZ)
  1. I $G(DVBZZ(0))'=1 D Q
  1. . D BMES^XPDUTL("NOTE: THE NEW SECURITY KEY 'DVBA CAPRI CLIN DOC-EFOLDER' DID NOT SUCCESSFULLY UPDATE WITH THE REQUIRED HOLDERS.")
  1. . D BMES^XPDUTL("THE USER RUNNING THIS POST INSTALL ROUTINE DOES NOT HAVE XUMGR KEY ASSIGNED TO THEM.")
  1. . D BMES^XPDUTL("PLEASE RUN SECKEY^DVBCP238 AGAIN WITH USER WHO IS A HOLDER OF THE 'XUMGR' SECURITY KEY.")
  1. ;
  1. K ^TMP($J,"DVBCP238")
  1. ;
  1. D NOW^%DTC S DVBTODAY=X ;X STILL DOESN'T HAVE A VALUE AFTER RUNNING API
  1. ;
  1. ;FIND DVBA CAPRI GUI IN OPTION FILE (SHOULD ALWAYS BE 9510) BUT CHECKING JUST THE SAME
  1. S DVBSTOP1=0,DVBOPIEN=""
  1. S DVBIEN=0 F S DVBIEN=$O(^DIC(19,DVBIEN)) Q:DVBIEN=""!('DVBIEN)!(DVBSTOP1=1) D
  1. . S DVBNAME=$G(^DIC(19,DVBIEN,0))
  1. . S DVBNAME=$P(DVBNAME,"^",1) ;ASSIGNING THE NAME
  1. . I DVBNAME="DVBA CAPRI GUI" S DVBSTOP1=1,DVBOPIEN=DVBIEN
  1. I DVBOPIEN="" D BMES^XPDUTL("'DVBA CAPRI GUI' OPTION NOT FOUND IN OPTION FILE. USERS OF DVBA CAPRI CLIN DOC-EFOLDER COULD NOT BE SETUP") Q
  1. ;
  1. ;FIND PERSONS WITH DVBA CAPRI GUI OPTION
  1. I DVBOPIEN'="" D
  1. . S DVBPRDUZ=0 F S DVBPRDUZ=$O(^VA(200,DVBPRDUZ)) Q:DVBPRDUZ=""!('DVBPRDUZ) D
  1. .. K DVBMSG,DVBERR
  1. .. D GETS^DIQ(200,DVBPRDUZ_",","9.2","I","DVBMSG","DVBERR")
  1. .. I $G(DVBMSG(200,DVBPRDUZ_",",9.2,"I"))'="",($G(DVBMSG(200,DVBPRDUZ_",",9.2,"I"))<=DVBTODAY) D Q
  1. ... S ^TMP($J,"DVBCP238",DVBPRDUZ,"TERMEDPERSON")=""
  1. .. ;
  1. .. I $G(^VA(200,DVBPRDUZ,201)) I $P(^VA(200,DVBPRDUZ,201),"^",1)=DVBOPIEN S ^TMP($J,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")="" Q
  1. .. Q:'$D(^VA(200,DVBPRDUZ,203))
  1. .. S DVBSTOP1=0
  1. .. S DVBMNU=0 F S DVBMNU=$O(^VA(200,DVBPRDUZ,203,DVBMNU)) Q:DVBMNU=""!('DVBMNU)!(DVBSTOP1=1) D
  1. ... I $G(^VA(200,DVBPRDUZ,203,DVBMNU,0)) I $P(^VA(200,DVBPRDUZ,203,DVBMNU,0),"^",1)=DVBOPIEN S DVBSTOP1=1,^TMP($J,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")=""
  1. ;
  1. ;DOES THE USER HAVE ACCESS TO THE CURRENT KEY
  1. S DVBKEYNO=$$LKUP^XPDKEY("DVBA CAPRI CLIN DOC-EFOLDER")
  1. I $G(DVBKEYNO)="" D BMES^XPDUTL("'DVBA CAPRI CLIN DOC-EFOLDER' SECURITY KEY HAS NOT BEEN ADDED. SECKEY^DVBCP238 CAN NOT CONTINUE") Q
  1. S DVBPRDUZ=0 F S DVBPRDUZ=$O(^VA(200,DVBPRDUZ)) Q:DVBPRDUZ=""!('DVBPRDUZ) D
  1. . I $D(^VA(200,DVBPRDUZ,51,DVBKEYNO)) D Q
  1. .. S ^TMP($J,"DVBCP238",DVBPRDUZ,"DVBA CAPRI CLIN DOC-EFOLDER")=""
  1. .. I $D(^TMP($J,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")) S ^TMP($J,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")="DVBA CAPRI CLIN DOC-EFOLDER"
  1. ;
  1. ;ADD NEW SECURITY KEY TO ALL NON-TERMED PERSONS WHO DON'T HAVE OLD KEY
  1. S DVBPRDUZ=0 F S DVBPRDUZ=$O(^TMP($J,"DVBCP238",DVBPRDUZ)) Q:DVBPRDUZ=""!('DVBPRDUZ) D
  1. .;DO NOT INCLUDE USERS WHO ARE VISITORS
  1. . Q:$D(^VA(200,DVBPRDUZ,3,"B","VISITOR"))=10
  1. . Q:'$D(^TMP($J,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION"))
  1. . Q:$D(^TMP($J,"DVBCP238",DVBPRDUZ,"TERMEDPERSON"))
  1. . Q:$D(^TMP($J,"DVBCP238",DVBPRDUZ,"DVBA CAPRI CLIN DOC-EFOLDER"))
  1. . ;IF AFTER FIRST RUN THIS ROUTINE IS RUN AGAIN EXCLUDE DVBPER WITH KEY FROM FIRST RUN
  1. . Q:$D(^XUSEC("DVBA CAPRI CLIN DOC-EFOLDER",DVBPRDUZ))
  1. . K DVBFDA,DVBERR,DIERR,DVBKYIEN
  1. . S DVBFDA(200.051,"+1,"_DVBPRDUZ_",",.01)=DVBKEYNO
  1. . S DVBFDA(200.051,"+1,"_DVBPRDUZ_",",1)=DUZ
  1. . S DVBFDA(200.051,"+1,"_DVBPRDUZ_",",2)=DVBTODAY
  1. . S DVBKYIEN(1)=DVBKEYNO
  1. . D UPDATE^DIE("","DVBFDA","DVBKYIEN","DVBERR")
  1. . S DVBPER=$P(^VA(200,DVBPRDUZ,0),"^",1)
  1. . I $D(DIERR) D BMES^XPDUTL(""_DVBPRDUZ_" ("_DVBPER_") SHOULD BE ASSIGNED THE SECURITY KEY 'DVBA CAPRI CLIN DOC-EFOLDER'. PLEASE SET THIS PERSON MANUALLY") Q
  1. ;
  1. K ^TMP($J,"DVBCP238")
  1. D BMES^XPDUTL("SECURITY KEY UPDATE IS COMPLETE")
  1. Q