ORY629 ;NA/WAT - PRE/POST OR*3.0*629 ;Jan 27, 2025@11:14:53
;;3.0;ORDER ENTRY/RESULTS REPORTING;**629**;;Build 5
; Reference to ^XPAR in ICR #2263
Q
POST ; post-init
;find any SYS entries where value = cprsdevsonly@dvagov.onmicrosoft.com
;and change those entries to the new value of oitspmhspcprser@domain.ext
;if no SYS value found, set it.
;D ENVAL^XPAR(.LIST,"OR CPRS EXCEPTION EMAIL",,.ERR)
;if SYS and old email, update to new
N LIST,PARM,VALUE
S PARM="OR CPRS EXCEPTION EMAIL",VALUE="oitspmhspcprser@domain.ext"
D ENVAL^XPAR(.LIST,PARM,,.ERR)
I $G(ERR)'=0 D ERROR K ERR Q ;can't find parameter
N I,J S I="",J=0
F S I=$O(LIST(I)) Q:$G(I)="" D
. Q:$G(I)'["DIC(4.2"
. F S J=$O(LIST(I,J)) Q:+$G(J)=0 D
. . I LIST(I,J)["CPRSDevsOnly" D
. . . D BMES^XPDUTL("Updating exception email SYS parameter value...")
. . . D CHG^XPAR(I,PARM,J,VALUE,.ERR)
. . . I $G(ERR)'=0 D ERROR Q
. . . D MES^XPDUTL("Update complete.")
I $$GET^XPAR("SYS",PARM,1,"E")'=VALUE D
. ;no SYS value for CPRS found, set it.
. D BMES^XPDUTL("Setting exception email SYS parameter value...")
. D EN^XPAR("SYS",PARM,,VALUE,.ERR)
. I $G(ERR)'=0 D ERROR
. D MES^XPDUTL("Set complete.")
K ERR
Q
ERROR ; display error
D BMES^XPDUTL(" ERROR UPDATING THE ""OR CPRS EXCEPTION EMAIL"" PARAMETER ")
D MES^XPDUTL("ERROR MESSAGE: "_$P(ERR,"^",2))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY629 1384 printed Sep 23, 2025@20:19:17 Page 2
ORY629 ;NA/WAT - PRE/POST OR*3.0*629 ;Jan 27, 2025@11:14:53
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**629**;;Build 5
+2 ; Reference to ^XPAR in ICR #2263
+3 QUIT
POST ; post-init
+1 ;find any SYS entries where value = cprsdevsonly@dvagov.onmicrosoft.com
+2 ;and change those entries to the new value of oitspmhspcprser@domain.ext
+3 ;if no SYS value found, set it.
+4 ;D ENVAL^XPAR(.LIST,"OR CPRS EXCEPTION EMAIL",,.ERR)
+5 ;if SYS and old email, update to new
+6 NEW LIST,PARM,VALUE
+7 SET PARM="OR CPRS EXCEPTION EMAIL"
SET VALUE="oitspmhspcprser@domain.ext"
+8 DO ENVAL^XPAR(.LIST,PARM,,.ERR)
+9 ;can't find parameter
IF $GET(ERR)'=0
DO ERROR
KILL ERR
QUIT
+10 NEW I,J
SET I=""
SET J=0
+11 FOR
SET I=$ORDER(LIST(I))
if $GET(I)=""
QUIT
Begin DoDot:1
+12 if $GET(I)'["DIC(4.2"
QUIT
+13 FOR
SET J=$ORDER(LIST(I,J))
if +$GET(J)=0
QUIT
Begin DoDot:2
+14 IF LIST(I,J)["CPRSDevsOnly"
Begin DoDot:3
+15 DO BMES^XPDUTL("Updating exception email SYS parameter value...")
+16 DO CHG^XPAR(I,PARM,J,VALUE,.ERR)
+17 IF $GET(ERR)'=0
DO ERROR
QUIT
+18 DO MES^XPDUTL("Update complete.")
End DoDot:3
End DoDot:2
End DoDot:1
+19 IF $$GET^XPAR("SYS",PARM,1,"E")'=VALUE
Begin DoDot:1
+20 ;no SYS value for CPRS found, set it.
+21 DO BMES^XPDUTL("Setting exception email SYS parameter value...")
+22 DO EN^XPAR("SYS",PARM,,VALUE,.ERR)
+23 IF $GET(ERR)'=0
DO ERROR
+24 DO MES^XPDUTL("Set complete.")
End DoDot:1
+25 KILL ERR
+26 QUIT
ERROR ; display error
+1 DO BMES^XPDUTL(" ERROR UPDATING THE ""OR CPRS EXCEPTION EMAIL"" PARAMETER ")
+2 DO MES^XPDUTL("ERROR MESSAGE: "_$PIECE(ERR,"^",2))
+3 QUIT
