PRC51225 ;OI&T/LKG - ENV AND POST-INIT ;11/2/21 10:51
V ;;5.1;IFCAP;**225**;Oct 20, 2000;Build 3
;Per VA Directive 6402, this routine should not be modified.
ENV ;Check the configuration and issue warning if wrong
Q:$$PROD^XUPROD
N PRCA
S PRCA(1)=" ",PRCA(2)="Warning: The FINANCIAL MANAGEMENT BATCH DOMAIN MAIL ROUTER value"
S PRCA(3)="is inconsistent with PRODUCTION/TEST type of this VistA account."
S PRCA(4)="If you are testing this patch in a Mirror/Test account, please change"
S PRCA(5)="'Q-FMS.DOMAIN.EXT' to 'Q-FMT.DOMAIN.EXT' before testing."
D:'$$CONFIGCK EN^DDIOL(.PRCA)
Q
;
;ICR 7309 GENERIC CODE SHEET BATCH TYPE LOOKUP
; Returns '1' if correct and '0' if not
CONFIGCK() ;Checks if Prod/Test setting and GECS Financial Management Domain
;are compatible
N PRCX,PRCY,PRCERR,PRCDOM
S PRCX=$$KSP^XUPARAM("WHERE"),PRCY=$L(PRCX,".")
I $P(PRCX,".",PRCY-1,PRCY)'="DOMAIN.EXT" Q 1
S PRCX=$$FIND1^DIC(2101.1,,"B","FINANCIAL MANAGEMENT",,,"PRCERR")
Q:PRCX'>0 0 Q:$D(PRCERR) 0
S PRCX=","_PRCX_","
S PRCY=$$FIND1^DIC(2101.12,PRCX,"B","XXX",,,"PRCERR"),PRCX=PRCY_PRCX
I $D(PRCERR)!(PRCY'>0) Q 0
S PRCDOM=$$GET1^DIQ(2101.12,PRCX,1,,,"PRCERR") K PRCERR
S PRCY=0
I PRCDOM=$S($$PROD^XUPROD:"Q-FMS.DOMAIN.EXT",1:"Q-FMT.DOMAIN.EXT") S PRCY=1
Q PRCY
;
POST ; Check configuration and write to installation warning if wrong
Q:$$PROD^XUPROD
N PRCA
S PRCA(1)=" ",PRCA(2)="Warning: The FINANCIAL MANAGEMENT BATCH DOMAIN MAIL ROUTER value"
S PRCA(3)="is inconsistent with PRODUCTION/TEST type of this VistA account."
S PRCA(4)="If you are testing this patch in a Mirror/Test account, please change"
S PRCA(5)="'Q-FMS.DOMAIN.EXT' to 'Q-FMT.DOMAIN.EXT' before testing."
D:'$$CONFIGCK MES^XPDUTL(.PRCA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC51225 1764 printed Oct 16, 2024@18:00:28 Page 2
PRC51225 ;OI&T/LKG - ENV AND POST-INIT ;11/2/21 10:51
V ;;5.1;IFCAP;**225**;Oct 20, 2000;Build 3
+1 ;Per VA Directive 6402, this routine should not be modified.
ENV ;Check the configuration and issue warning if wrong
+1 if $$PROD^XUPROD
QUIT
+2 NEW PRCA
+3 SET PRCA(1)=" "
SET PRCA(2)="Warning: The FINANCIAL MANAGEMENT BATCH DOMAIN MAIL ROUTER value"
+4 SET PRCA(3)="is inconsistent with PRODUCTION/TEST type of this VistA account."
+5 SET PRCA(4)="If you are testing this patch in a Mirror/Test account, please change"
+6 SET PRCA(5)="'Q-FMS.DOMAIN.EXT' to 'Q-FMT.DOMAIN.EXT' before testing."
+7 if '$$CONFIGCK
DO EN^DDIOL(.PRCA)
+8 QUIT
+9 ;
+10 ;ICR 7309 GENERIC CODE SHEET BATCH TYPE LOOKUP
+11 ; Returns '1' if correct and '0' if not
CONFIGCK() ;Checks if Prod/Test setting and GECS Financial Management Domain
+1 ;are compatible
+2 NEW PRCX,PRCY,PRCERR,PRCDOM
+3 SET PRCX=$$KSP^XUPARAM("WHERE")
SET PRCY=$LENGTH(PRCX,".")
+4 IF $PIECE(PRCX,".",PRCY-1,PRCY)'="DOMAIN.EXT"
QUIT 1
+5 SET PRCX=$$FIND1^DIC(2101.1,,"B","FINANCIAL MANAGEMENT",,,"PRCERR")
+6 if PRCX'>0
QUIT 0
if $DATA(PRCERR)
QUIT 0
+7 SET PRCX=","_PRCX_","
+8 SET PRCY=$$FIND1^DIC(2101.12,PRCX,"B","XXX",,,"PRCERR")
SET PRCX=PRCY_PRCX
+9 IF $DATA(PRCERR)!(PRCY'>0)
QUIT 0
+10 SET PRCDOM=$$GET1^DIQ(2101.12,PRCX,1,,,"PRCERR")
KILL PRCERR
+11 SET PRCY=0
+12 IF PRCDOM=$SELECT($$PROD^XUPROD:"Q-FMS.DOMAIN.EXT",1:"Q-FMT.DOMAIN.EXT")
SET PRCY=1
+13 QUIT PRCY
+14 ;
POST ; Check configuration and write to installation warning if wrong
+1 if $$PROD^XUPROD
QUIT
+2 NEW PRCA
+3 SET PRCA(1)=" "
SET PRCA(2)="Warning: The FINANCIAL MANAGEMENT BATCH DOMAIN MAIL ROUTER value"
+4 SET PRCA(3)="is inconsistent with PRODUCTION/TEST type of this VistA account."
+5 SET PRCA(4)="If you are testing this patch in a Mirror/Test account, please change"
+6 SET PRCA(5)="'Q-FMS.DOMAIN.EXT' to 'Q-FMT.DOMAIN.EXT' before testing."
+7 if '$$CONFIGCK
DO MES^XPDUTL(.PRCA)
+8 QUIT
