DVBCP238 ;ALB/FSB - PATCH DVBA*2.7*238 POST-INSTALL ROUTINE; MAR 29, 2022@17:00
;;2.7;AMIE;**238**;Apr 10, 1995;Build 16
;
; Reference to XUS KEY CHECK in ICR #6286
; Reference to XUS ALLKEYS in ICR #6287
;
Q
SECKEY ;
;
N DVBKEYNO,DVBIEN,DVBMNU,DVBSTOP1,DVBNAME,DVBOPIEN,DVBPRDUZ,DVBMSG,DVBERR,DVBKYIEN,DVBPER,DVBTODAY,X,DVBZZ
;
S DVBZZ="" D OWNSKEY^XUSRB(.DVBZZ,"XUMGR",DUZ)
I $G(DVBZZ(0))'=1 D Q
. D BMES^XPDUTL("NOTE: THE NEW SECURITY KEY 'DVBA CAPRI CLIN DOC-EFOLDER' DID NOT SUCCESSFULLY UPDATE WITH THE REQUIRED HOLDERS.")
. D BMES^XPDUTL("THE USER RUNNING THIS POST INSTALL ROUTINE DOES NOT HAVE XUMGR KEY ASSIGNED TO THEM.")
. D BMES^XPDUTL("PLEASE RUN SECKEY^DVBCP238 AGAIN WITH USER WHO IS A HOLDER OF THE 'XUMGR' SECURITY KEY.")
;
K ^TMP($J,"DVBCP238")
;
D NOW^%DTC S DVBTODAY=X ;X STILL DOESN'T HAVE A VALUE AFTER RUNNING API
;
;FIND DVBA CAPRI GUI IN OPTION FILE (SHOULD ALWAYS BE 9510) BUT CHECKING JUST THE SAME
S DVBSTOP1=0,DVBOPIEN=""
S DVBIEN=0 F S DVBIEN=$O(^DIC(19,DVBIEN)) Q:DVBIEN=""!('DVBIEN)!(DVBSTOP1=1) D
. S DVBNAME=$G(^DIC(19,DVBIEN,0))
. S DVBNAME=$P(DVBNAME,"^",1) ;ASSIGNING THE NAME
. I DVBNAME="DVBA CAPRI GUI" S DVBSTOP1=1,DVBOPIEN=DVBIEN
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
;
;FIND PERSONS WITH DVBA CAPRI GUI OPTION
I DVBOPIEN'="" D
. S DVBPRDUZ=0 F S DVBPRDUZ=$O(^VA(200,DVBPRDUZ)) Q:DVBPRDUZ=""!('DVBPRDUZ) D
.. K DVBMSG,DVBERR
.. D GETS^DIQ(200,DVBPRDUZ_",","9.2","I","DVBMSG","DVBERR")
.. I $G(DVBMSG(200,DVBPRDUZ_",",9.2,"I"))'="",($G(DVBMSG(200,DVBPRDUZ_",",9.2,"I"))<=DVBTODAY) D Q
... S ^TMP($J,"DVBCP238",DVBPRDUZ,"TERMEDPERSON")=""
.. ;
.. I $G(^VA(200,DVBPRDUZ,201)) I $P(^VA(200,DVBPRDUZ,201),"^",1)=DVBOPIEN S ^TMP($J,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")="" Q
.. Q:'$D(^VA(200,DVBPRDUZ,203))
.. S DVBSTOP1=0
.. S DVBMNU=0 F S DVBMNU=$O(^VA(200,DVBPRDUZ,203,DVBMNU)) Q:DVBMNU=""!('DVBMNU)!(DVBSTOP1=1) D
... 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")=""
;
;DOES THE USER HAVE ACCESS TO THE CURRENT KEY
S DVBKEYNO=$$LKUP^XPDKEY("DVBA CAPRI CLIN DOC-EFOLDER")
I $G(DVBKEYNO)="" D BMES^XPDUTL("'DVBA CAPRI CLIN DOC-EFOLDER' SECURITY KEY HAS NOT BEEN ADDED. SECKEY^DVBCP238 CAN NOT CONTINUE") Q
S DVBPRDUZ=0 F S DVBPRDUZ=$O(^VA(200,DVBPRDUZ)) Q:DVBPRDUZ=""!('DVBPRDUZ) D
. I $D(^VA(200,DVBPRDUZ,51,DVBKEYNO)) D Q
.. S ^TMP($J,"DVBCP238",DVBPRDUZ,"DVBA CAPRI CLIN DOC-EFOLDER")=""
.. I $D(^TMP($J,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")) S ^TMP($J,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")="DVBA CAPRI CLIN DOC-EFOLDER"
;
;ADD NEW SECURITY KEY TO ALL NON-TERMED PERSONS WHO DON'T HAVE OLD KEY
S DVBPRDUZ=0 F S DVBPRDUZ=$O(^TMP($J,"DVBCP238",DVBPRDUZ)) Q:DVBPRDUZ=""!('DVBPRDUZ) D
.;DO NOT INCLUDE USERS WHO ARE VISITORS
. Q:$D(^VA(200,DVBPRDUZ,3,"B","VISITOR"))=10
. Q:'$D(^TMP($J,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION"))
. Q:$D(^TMP($J,"DVBCP238",DVBPRDUZ,"TERMEDPERSON"))
. Q:$D(^TMP($J,"DVBCP238",DVBPRDUZ,"DVBA CAPRI CLIN DOC-EFOLDER"))
. ;IF AFTER FIRST RUN THIS ROUTINE IS RUN AGAIN EXCLUDE DVBPER WITH KEY FROM FIRST RUN
. Q:$D(^XUSEC("DVBA CAPRI CLIN DOC-EFOLDER",DVBPRDUZ))
. K DVBFDA,DVBERR,DIERR,DVBKYIEN
. S DVBFDA(200.051,"+1,"_DVBPRDUZ_",",.01)=DVBKEYNO
. S DVBFDA(200.051,"+1,"_DVBPRDUZ_",",1)=DUZ
. S DVBFDA(200.051,"+1,"_DVBPRDUZ_",",2)=DVBTODAY
. S DVBKYIEN(1)=DVBKEYNO
. D UPDATE^DIE("","DVBFDA","DVBKYIEN","DVBERR")
. S DVBPER=$P(^VA(200,DVBPRDUZ,0),"^",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
;
K ^TMP($J,"DVBCP238")
D BMES^XPDUTL("SECURITY KEY UPDATE IS COMPLETE")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCP238 3914 printed Sep 23, 2025@19:21:10 Page 2
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
+2 ;
+3 ; Reference to XUS KEY CHECK in ICR #6286
+4 ; Reference to XUS ALLKEYS in ICR #6287
+5 ;
+6 QUIT
SECKEY ;
+1 ;
+2 NEW DVBKEYNO,DVBIEN,DVBMNU,DVBSTOP1,DVBNAME,DVBOPIEN,DVBPRDUZ,DVBMSG,DVBERR,DVBKYIEN,DVBPER,DVBTODAY,X,DVBZZ
+3 ;
+4 SET DVBZZ=""
DO OWNSKEY^XUSRB(.DVBZZ,"XUMGR",DUZ)
+5 IF $GET(DVBZZ(0))'=1
Begin DoDot:1
+6 DO BMES^XPDUTL("NOTE: THE NEW SECURITY KEY 'DVBA CAPRI CLIN DOC-EFOLDER' DID NOT SUCCESSFULLY UPDATE WITH THE REQUIRED HOLDERS.")
+7 DO BMES^XPDUTL("THE USER RUNNING THIS POST INSTALL ROUTINE DOES NOT HAVE XUMGR KEY ASSIGNED TO THEM.")
+8 DO BMES^XPDUTL("PLEASE RUN SECKEY^DVBCP238 AGAIN WITH USER WHO IS A HOLDER OF THE 'XUMGR' SECURITY KEY.")
End DoDot:1
QUIT
+9 ;
+10 KILL ^TMP($JOB,"DVBCP238")
+11 ;
+12 ;X STILL DOESN'T HAVE A VALUE AFTER RUNNING API
DO NOW^%DTC
SET DVBTODAY=X
+13 ;
+14 ;FIND DVBA CAPRI GUI IN OPTION FILE (SHOULD ALWAYS BE 9510) BUT CHECKING JUST THE SAME
+15 SET DVBSTOP1=0
SET DVBOPIEN=""
+16 SET DVBIEN=0
FOR
SET DVBIEN=$ORDER(^DIC(19,DVBIEN))
if DVBIEN=""!('DVBIEN)!(DVBSTOP1=1)
QUIT
Begin DoDot:1
+17 SET DVBNAME=$GET(^DIC(19,DVBIEN,0))
+18 ;ASSIGNING THE NAME
SET DVBNAME=$PIECE(DVBNAME,"^",1)
+19 IF DVBNAME="DVBA CAPRI GUI"
SET DVBSTOP1=1
SET DVBOPIEN=DVBIEN
End DoDot:1
+20 IF DVBOPIEN=""
DO BMES^XPDUTL("'DVBA CAPRI GUI' OPTION NOT FOUND IN OPTION FILE. USERS OF DVBA CAPRI CLIN DOC-EFOLDER COULD NOT BE SETUP")
QUIT
+21 ;
+22 ;FIND PERSONS WITH DVBA CAPRI GUI OPTION
+23 IF DVBOPIEN'=""
Begin DoDot:1
+24 SET DVBPRDUZ=0
FOR
SET DVBPRDUZ=$ORDER(^VA(200,DVBPRDUZ))
if DVBPRDUZ=""!('DVBPRDUZ)
QUIT
Begin DoDot:2
+25 KILL DVBMSG,DVBERR
+26 DO GETS^DIQ(200,DVBPRDUZ_",","9.2","I","DVBMSG","DVBERR")
+27 IF $GET(DVBMSG(200,DVBPRDUZ_",",9.2,"I"))'=""
IF ($GET(DVBMSG(200,DVBPRDUZ_",",9.2,"I"))<=DVBTODAY)
Begin DoDot:3
+28 SET ^TMP($JOB,"DVBCP238",DVBPRDUZ,"TERMEDPERSON")=""
End DoDot:3
QUIT
+29 ;
+30 IF $GET(^VA(200,DVBPRDUZ,201))
IF $PIECE(^VA(200,DVBPRDUZ,201),"^",1)=DVBOPIEN
SET ^TMP($JOB,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")=""
QUIT
+31 if '$DATA(^VA(200,DVBPRDUZ,203))
QUIT
+32 SET DVBSTOP1=0
+33 SET DVBMNU=0
FOR
SET DVBMNU=$ORDER(^VA(200,DVBPRDUZ,203,DVBMNU))
if DVBMNU=""!('DVBMNU)!(DVBSTOP1=1)
QUIT
Begin DoDot:3
+34 IF $GET(^VA(200,DVBPRDUZ,203,DVBMNU,0))
IF $PIECE(^VA(200,DVBPRDUZ,203,DVBMNU,0),"^",1)=DVBOPIEN
SET DVBSTOP1=1
SET ^TMP($JOB,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")=""
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;
+36 ;DOES THE USER HAVE ACCESS TO THE CURRENT KEY
+37 SET DVBKEYNO=$$LKUP^XPDKEY("DVBA CAPRI CLIN DOC-EFOLDER")
+38 IF $GET(DVBKEYNO)=""
DO BMES^XPDUTL("'DVBA CAPRI CLIN DOC-EFOLDER' SECURITY KEY HAS NOT BEEN ADDED. SECKEY^DVBCP238 CAN NOT CONTINUE")
QUIT
+39 SET DVBPRDUZ=0
FOR
SET DVBPRDUZ=$ORDER(^VA(200,DVBPRDUZ))
if DVBPRDUZ=""!('DVBPRDUZ)
QUIT
Begin DoDot:1
+40 IF $DATA(^VA(200,DVBPRDUZ,51,DVBKEYNO))
Begin DoDot:2
+41 SET ^TMP($JOB,"DVBCP238",DVBPRDUZ,"DVBA CAPRI CLIN DOC-EFOLDER")=""
+42 IF $DATA(^TMP($JOB,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION"))
SET ^TMP($JOB,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION")="DVBA CAPRI CLIN DOC-EFOLDER"
End DoDot:2
QUIT
End DoDot:1
+43 ;
+44 ;ADD NEW SECURITY KEY TO ALL NON-TERMED PERSONS WHO DON'T HAVE OLD KEY
+45 SET DVBPRDUZ=0
FOR
SET DVBPRDUZ=$ORDER(^TMP($JOB,"DVBCP238",DVBPRDUZ))
if DVBPRDUZ=""!('DVBPRDUZ)
QUIT
Begin DoDot:1
+46 ;DO NOT INCLUDE USERS WHO ARE VISITORS
+47 if $DATA(^VA(200,DVBPRDUZ,3,"B","VISITOR"))=10
QUIT
+48 if '$DATA(^TMP($JOB,"DVBCP238",DVBPRDUZ,"USERSWITHOPTION"))
QUIT
+49 if $DATA(^TMP($JOB,"DVBCP238",DVBPRDUZ,"TERMEDPERSON"))
QUIT
+50 if $DATA(^TMP($JOB,"DVBCP238",DVBPRDUZ,"DVBA CAPRI CLIN DOC-EFOLDER"))
QUIT
+51 ;IF AFTER FIRST RUN THIS ROUTINE IS RUN AGAIN EXCLUDE DVBPER WITH KEY FROM FIRST RUN
+52 if $DATA(^XUSEC("DVBA CAPRI CLIN DOC-EFOLDER",DVBPRDUZ))
QUIT
+53 KILL DVBFDA,DVBERR,DIERR,DVBKYIEN
+54 SET DVBFDA(200.051,"+1,"_DVBPRDUZ_",",.01)=DVBKEYNO
+55 SET DVBFDA(200.051,"+1,"_DVBPRDUZ_",",1)=DUZ
+56 SET DVBFDA(200.051,"+1,"_DVBPRDUZ_",",2)=DVBTODAY
+57 SET DVBKYIEN(1)=DVBKEYNO
+58 DO UPDATE^DIE("","DVBFDA","DVBKYIEN","DVBERR")
+59 SET DVBPER=$PIECE(^VA(200,DVBPRDUZ,0),"^",1)
+60 IF $DATA(DIERR)
DO BMES^XPDUTL(""_DVBPRDUZ_" ("_DVBPER_") SHOULD BE ASSIGNED THE SECURITY KEY 'DVBA CAPRI CLIN DOC-EFOLDER'. PLEASE SET THIS PERSON MANUALLY")
QUIT
End DoDot:1
+61 ;
+62 KILL ^TMP($JOB,"DVBCP238")
+63 DO BMES^XPDUTL("SECURITY KEY UPDATE IS COMPLETE")
+64 QUIT
