- 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 Feb 18, 2025@23:11:33 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