ONC2PR21 ;HINES OIFO/RTK - Pre-Install Routine for Patch ONC*2.2*21 ;10/23/24
;;2.2;ONCOLOGY;**21**;Jul 31, 2013;Build 6
;
; ICRs:
; #10141 XPDUTL
; #10060 FILE 200 fields
Q
START ;start pre-init changes
K ^ONCO(160.16) ;delete 160.16 and bring back in patch 21 build
K ^ONCO(164) ;delete 164 and bring back in patch 21 build
K ^ONCO(164.44) ;delete 164.44 and bring back in patch 21 build
K ^ONCO(165.8) ;delete 165.8 and bring back in patch 21 build
K ^ONCO(165.9) ;delete 165.9 and bring back in patch 21 build
K ^ONCO(166) ;delete 166 and bring back in patch 21 build
K ^ONCO(167.1) ;delete 167.1 and bring back in patch 21 build
K ^ONCO(167.7) ;delete 167.7 and bring back in patch 21 build
K ^ONCO(169.3) ;delete 169.3 and bring back in patch 21 build
D INITIALS
D USERV
Q
;
INITIALS ;Check if Oncology Registrar has initials in FILE 200
;FILE 165.5 - ONCOLOGY PRIMARY
;FILE 200 - NEW PERSON
D BMES^XPDUTL("Checking if Oncology Registrar has INITIAL (#1) value in the NEW PERSON file (#200)")
N ONCDUZ,ONCIEN,ONCINITIALS,ONCLIST,ONCNODE,ONCUSER
S ONCIEN=0
F S ONCIEN=$O(^ONCO(165.5,ONCIEN)) Q:'ONCIEN D
.S ONCNODE=$G(^ONCO(165.5,ONCIEN,7))
.S ONCDUZ=$P(ONCNODE,U,3) ;(#92) ABSTRACTED BY - pointer to FILE 200
.Q:ONCDUZ="" ;field can be null if the case is not "Completed"
.S ONCINITIALS=$$GET1^DIQ(200,ONCDUZ_",",1,,,"ONCMSG")
.Q:ONCINITIALS'="" ;there are user initials
.S ONCUSER=$$GET1^DIQ(200,ONCDUZ_",",.01,,,"ONCMSG")
.S ONCLIST(ONCDUZ)=ONCUSER
I '$D(ONCLIST) D Q
.D BMES^XPDUTL("All Registrars have initials defined.")
D BMES^XPDUTL("The following users do not have their Initials in FILE 200, Field #1.")
S ONCDUZ=0
F S ONCDUZ=$O(ONCLIST(ONCDUZ)) Q:'ONCDUZ D
.S ONCUSER=ONCLIST(ONCDUZ)
.D BMES^XPDUTL(ONCUSER)
Q
USERV ;Update url to Production or Development server
N ONCSYS
S ONCSYS=$$PROD^XUPROD()
S DA=$O(^XOB(18.12,"B","ONCO WEB SERVER",""))
;production url
I ONCSYS D
.S DIE="^XOB(18.12,",DR=".04///^S X=""va-reg-prod-apim.reg.vaec.domain.ext""" D ^DIE
.W !,"Oncology Web Server is updated to Production url...",!
;development url
I 'ONCSYS D
.S DIE="^XOB(18.12,",DR=".04///^S X=""va-reg-preprod-apim.reg.vaec.domain.ext""" D ^DIE
.W !,"Oncology Web Server is updated to Development url...",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONC2PR21 2351 printed Aug 26, 2025@22:37:31 Page 2
ONC2PR21 ;HINES OIFO/RTK - Pre-Install Routine for Patch ONC*2.2*21 ;10/23/24
+1 ;;2.2;ONCOLOGY;**21**;Jul 31, 2013;Build 6
+2 ;
+3 ; ICRs:
+4 ; #10141 XPDUTL
+5 ; #10060 FILE 200 fields
+6 QUIT
START ;start pre-init changes
+1 ;delete 160.16 and bring back in patch 21 build
KILL ^ONCO(160.16)
+2 ;delete 164 and bring back in patch 21 build
KILL ^ONCO(164)
+3 ;delete 164.44 and bring back in patch 21 build
KILL ^ONCO(164.44)
+4 ;delete 165.8 and bring back in patch 21 build
KILL ^ONCO(165.8)
+5 ;delete 165.9 and bring back in patch 21 build
KILL ^ONCO(165.9)
+6 ;delete 166 and bring back in patch 21 build
KILL ^ONCO(166)
+7 ;delete 167.1 and bring back in patch 21 build
KILL ^ONCO(167.1)
+8 ;delete 167.7 and bring back in patch 21 build
KILL ^ONCO(167.7)
+9 ;delete 169.3 and bring back in patch 21 build
KILL ^ONCO(169.3)
+10 DO INITIALS
+11 DO USERV
+12 QUIT
+13 ;
INITIALS ;Check if Oncology Registrar has initials in FILE 200
+1 ;FILE 165.5 - ONCOLOGY PRIMARY
+2 ;FILE 200 - NEW PERSON
+3 DO BMES^XPDUTL("Checking if Oncology Registrar has INITIAL (#1) value in the NEW PERSON file (#200)")
+4 NEW ONCDUZ,ONCIEN,ONCINITIALS,ONCLIST,ONCNODE,ONCUSER
+5 SET ONCIEN=0
+6 FOR
SET ONCIEN=$ORDER(^ONCO(165.5,ONCIEN))
if 'ONCIEN
QUIT
Begin DoDot:1
+7 SET ONCNODE=$GET(^ONCO(165.5,ONCIEN,7))
+8 ;(#92) ABSTRACTED BY - pointer to FILE 200
SET ONCDUZ=$PIECE(ONCNODE,U,3)
+9 ;field can be null if the case is not "Completed"
if ONCDUZ=""
QUIT
+10 SET ONCINITIALS=$$GET1^DIQ(200,ONCDUZ_",",1,,,"ONCMSG")
+11 ;there are user initials
if ONCINITIALS'=""
QUIT
+12 SET ONCUSER=$$GET1^DIQ(200,ONCDUZ_",",.01,,,"ONCMSG")
+13 SET ONCLIST(ONCDUZ)=ONCUSER
End DoDot:1
+14 IF '$DATA(ONCLIST)
Begin DoDot:1
+15 DO BMES^XPDUTL("All Registrars have initials defined.")
End DoDot:1
QUIT
+16 DO BMES^XPDUTL("The following users do not have their Initials in FILE 200, Field #1.")
+17 SET ONCDUZ=0
+18 FOR
SET ONCDUZ=$ORDER(ONCLIST(ONCDUZ))
if 'ONCDUZ
QUIT
Begin DoDot:1
+19 SET ONCUSER=ONCLIST(ONCDUZ)
+20 DO BMES^XPDUTL(ONCUSER)
End DoDot:1
+21 QUIT
USERV ;Update url to Production or Development server
+1 NEW ONCSYS
+2 SET ONCSYS=$$PROD^XUPROD()
+3 SET DA=$ORDER(^XOB(18.12,"B","ONCO WEB SERVER",""))
+4 ;production url
+5 IF ONCSYS
Begin DoDot:1
+6 SET DIE="^XOB(18.12,"
SET DR=".04///^S X=""va-reg-prod-apim.reg.vaec.domain.ext"""
DO ^DIE
+7 WRITE !,"Oncology Web Server is updated to Production url...",!
End DoDot:1
+8 ;development url
+9 IF 'ONCSYS
Begin DoDot:1
+10 SET DIE="^XOB(18.12,"
SET DR=".04///^S X=""va-reg-preprod-apim.reg.vaec.domain.ext"""
DO ^DIE
+11 WRITE !,"Oncology Web Server is updated to Development url...",!
End DoDot:1
+12 QUIT
