PRC51110 ;VMP/TJH ; Post Install routine for PRC*5.1*110 ; 07/20/2007
;;5.1;IFCAP;**110**;Oct 20, 2000;Build 7
;
Q ; Do Not Enter at routine label
;
EN ; Entry point.
TMMSG ; Send message reporting any address issues found during installation
D BMES^XPDUTL("Validating VA FSC mailing address, please wait...")
N PRCSTA,PRCA
S PRCSTA=0,U="^"
F S PRCSTA=$O(^PRC(411,PRCSTA)) Q:'PRCSTA D
. S PRCSTN=$O(^DIC(4,"D",$P(^PRC(411,PRCSTA,0),U,1),"")) Q:PRCSTN=""
. S PRCMAX=0,PRCFSC=0
. F S PRCMAX=$O(^PRC(411,PRCSTA,4,PRCMAX)) Q:'PRCMAX D
.. S PRCMAN=$P(^PRC(411,PRCSTA,4,PRCMAX,0),U,1)
.. I $E(PRCMAN,1,6)="VA FSC" S PRCFSC=1
.. I $E(PRCMAN,1,3)="FMS" S PRCA(PRCSTN,PRCMAX)=PRCMAN
. I 'PRCFSC S PRCA(PRCSTN,0)="No VA FSC address."
I '$D(PRCA) D BMES^XPDUTL("Validation complete.") Q ; if nothing found, don't send MailMan message.
;
N DA,PRCC,PRCGROUP,PRCPARAM,PRCTXT,XMDUZ,XMSUB,XMTEXT,XMY
N PRC1,PRC2,PRCFSC,PRCMAN,PRCMAX,PRCNP,PRCSTR1,PRCSTR2,PRCTITLE,PRCTX
S XMSUB="IMPORTANT BULLETIN FROM IFCAP PATCH PRC*5.1*110"
S XMDUZ=DUZ,XMTEXT="PRCTXT"
S PRCPARAM("FROM")="PATCH PRC*5.1*110 ADDRESS VERIFICATION"
; find purchasing/finance staff to send report to
S PRCTX=0 K PRCJB
F S PRCTX=$O(^DIC(3.1,PRCTX)) Q:'PRCTX D
. S PRCTITLE=$P(^DIC(3.1,PRCTX,0),U,1)
. F PRCSTR1="FISCAL","PURCH","FINAN","PROCUR","IFCAP" I $F(PRCTITLE,PRCSTR1) D
.. F PRCSTR2="CHIEF","ADMIN","SUPER","COORD" I $F(PRCTITLE,PRCSTR2) S PRCJB(PRCTX)=""
S PRCNP=1
F S PRCNP=$O(^VA(200,PRCNP)) Q:'PRCNP D
. S PRCTX=$P($G(^VA(200,PRCNP,0)),U,9)
. Q:PRCTX="" ; Quit if there is no job title
. Q:'$D(PRCJB(PRCTX)) ; Quit if job title not one we're looking for
. Q:$P(^VA(200,PRCNP,0),U,7) ; Quit if DISUSERed
. S XMY(PRCNP)="" ; add this responsible party to mail list.
S XMY(DUZ)="" ; add the patch installer to the mail list
;
S PRCC=0
S PRCC=PRCC+1,PRCTXT(PRCC)="This message has been sent by patch PRC*5.1*110 at the completion of"
S PRCC=PRCC+1,PRCTXT(PRCC)="the verification of the Mailing Address change for VA FSC."
S PRCC=PRCC+1,PRCTXT(PRCC)="The purpose of this message is to report any remaining addresses which"
S PRCC=PRCC+1,PRCTXT(PRCC)="might need to be edited and to report any Stations/Substations which"
S PRCC=PRCC+1,PRCTXT(PRCC)="might need the VA FSC address added. You can use the 'Site Parameters'"
S PRCC=PRCC+1,PRCTXT(PRCC)="option to edit the MAIL INVOICE LOCATION entries if necessary."
S PRCC=PRCC+1,PRCTXT(PRCC)=" "
S PRCC=PRCC+1,PRCTXT(PRCC)="As reported in the patch description, the Corporate Franchise Data Center"
S PRCC=PRCC+1,PRCTXT(PRCC)="in Austin has changed the preferred address name for IFCAP communications"
S PRCC=PRCC+1,PRCTXT(PRCC)="from FMS to VA FSC. This report lists any stations in your system that"
S PRCC=PRCC+1,PRCTXT(PRCC)="do not have a MAIL INVOICE LOCATION starting with VA FSC. The necessity"
S PRCC=PRCC+1,PRCTXT(PRCC)="for the address only applies to Stations/Substations that will be using"
S PRCC=PRCC+1,PRCTXT(PRCC)="requisitions. You will need to make a local determination as to which"
S PRCC=PRCC+1,PRCTXT(PRCC)="stations this applies to at your facility. Additionally, the report"
S PRCC=PRCC+1,PRCTXT(PRCC)="lists addresses which contain the old FMS abbreviation. These could"
S PRCC=PRCC+1,PRCTXT(PRCC)="be considered for editing or deletion. Again, this should be a local"
S PRCC=PRCC+1,PRCTXT(PRCC)="determination that cannot be automated by this patch."
S PRCC=PRCC+1,PRCTXT(PRCC)=" "
S PRCC=PRCC+1,PRCTXT(PRCC)="The following Stations/Substations do not have a VA FSC address entry"
S PRCC=PRCC+1,PRCTXT(PRCC)="in the ADMIN. ACTIVITY SITE PARAMETER file."
S DA=0
F S DA=$O(PRCA(DA)) Q:DA="" Q:'$D(PRCA(DA,0)) D
. S PRCC=PRCC+1
. S PRCTXT(PRCC)=$P(^DIC(4,DA,99),U,1)
. K PRCA(DA,0)
S PRCC=PRCC+1,PRCTXT(PRCC)=" "
S PRCC=PRCC+1,PRCTXT(PRCC)="The following Stations/Substations have an FMS address which may need"
S PRCC=PRCC+1,PRCTXT(PRCC)="to be edited."
S PRC1=0
F S PRC1=$O(PRCA(PRC1)) Q:PRC1="" D
. S PRC2=0
. F S PRC2=$O(PRCA(PRC1,PRC2)) Q:PRC2="" D
.. S PRCC=PRCC+1
.. S PRCTXT(PRCC)=$P(^DIC(4,PRC1,99),U,1)_" "_PRCA(PRC1,PRC2)
D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.IBPARAM,"","")
D BMES^XPDUTL("Address validation complete, a MailMan message has been sent listing items")
D MES^XPDUTL("which may need to be reviewed.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC51110 4447 printed Sep 23, 2025@19:35:40 Page 2
PRC51110 ;VMP/TJH ; Post Install routine for PRC*5.1*110 ; 07/20/2007
+1 ;;5.1;IFCAP;**110**;Oct 20, 2000;Build 7
+2 ;
+3 ; Do Not Enter at routine label
QUIT
+4 ;
EN ; Entry point.
TMMSG ; Send message reporting any address issues found during installation
+1 DO BMES^XPDUTL("Validating VA FSC mailing address, please wait...")
+2 NEW PRCSTA,PRCA
+3 SET PRCSTA=0
SET U="^"
+4 FOR
SET PRCSTA=$ORDER(^PRC(411,PRCSTA))
if 'PRCSTA
QUIT
Begin DoDot:1
+5 SET PRCSTN=$ORDER(^DIC(4,"D",$PIECE(^PRC(411,PRCSTA,0),U,1),""))
if PRCSTN=""
QUIT
+6 SET PRCMAX=0
SET PRCFSC=0
+7 FOR
SET PRCMAX=$ORDER(^PRC(411,PRCSTA,4,PRCMAX))
if 'PRCMAX
QUIT
Begin DoDot:2
+8 SET PRCMAN=$PIECE(^PRC(411,PRCSTA,4,PRCMAX,0),U,1)
+9 IF $EXTRACT(PRCMAN,1,6)="VA FSC"
SET PRCFSC=1
+10 IF $EXTRACT(PRCMAN,1,3)="FMS"
SET PRCA(PRCSTN,PRCMAX)=PRCMAN
End DoDot:2
+11 IF 'PRCFSC
SET PRCA(PRCSTN,0)="No VA FSC address."
End DoDot:1
+12 ; if nothing found, don't send MailMan message.
IF '$DATA(PRCA)
DO BMES^XPDUTL("Validation complete.")
QUIT
+13 ;
+14 NEW DA,PRCC,PRCGROUP,PRCPARAM,PRCTXT,XMDUZ,XMSUB,XMTEXT,XMY
+15 NEW PRC1,PRC2,PRCFSC,PRCMAN,PRCMAX,PRCNP,PRCSTR1,PRCSTR2,PRCTITLE,PRCTX
+16 SET XMSUB="IMPORTANT BULLETIN FROM IFCAP PATCH PRC*5.1*110"
+17 SET XMDUZ=DUZ
SET XMTEXT="PRCTXT"
+18 SET PRCPARAM("FROM")="PATCH PRC*5.1*110 ADDRESS VERIFICATION"
+19 ; find purchasing/finance staff to send report to
+20 SET PRCTX=0
KILL PRCJB
+21 FOR
SET PRCTX=$ORDER(^DIC(3.1,PRCTX))
if 'PRCTX
QUIT
Begin DoDot:1
+22 SET PRCTITLE=$PIECE(^DIC(3.1,PRCTX,0),U,1)
+23 FOR PRCSTR1="FISCAL","PURCH","FINAN","PROCUR","IFCAP"
IF $FIND(PRCTITLE,PRCSTR1)
Begin DoDot:2
+24 FOR PRCSTR2="CHIEF","ADMIN","SUPER","COORD"
IF $FIND(PRCTITLE,PRCSTR2)
SET PRCJB(PRCTX)=""
End DoDot:2
End DoDot:1
+25 SET PRCNP=1
+26 FOR
SET PRCNP=$ORDER(^VA(200,PRCNP))
if 'PRCNP
QUIT
Begin DoDot:1
+27 SET PRCTX=$PIECE($GET(^VA(200,PRCNP,0)),U,9)
+28 ; Quit if there is no job title
if PRCTX=""
QUIT
+29 ; Quit if job title not one we're looking for
if '$DATA(PRCJB(PRCTX))
QUIT
+30 ; Quit if DISUSERed
if $PIECE(^VA(200,PRCNP,0),U,7)
QUIT
+31 ; add this responsible party to mail list.
SET XMY(PRCNP)=""
End DoDot:1
+32 ; add the patch installer to the mail list
SET XMY(DUZ)=""
+33 ;
+34 SET PRCC=0
+35 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="This message has been sent by patch PRC*5.1*110 at the completion of"
+36 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="the verification of the Mailing Address change for VA FSC."
+37 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="The purpose of this message is to report any remaining addresses which"
+38 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="might need to be edited and to report any Stations/Substations which"
+39 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="might need the VA FSC address added. You can use the 'Site Parameters'"
+40 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="option to edit the MAIL INVOICE LOCATION entries if necessary."
+41 SET PRCC=PRCC+1
SET PRCTXT(PRCC)=" "
+42 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="As reported in the patch description, the Corporate Franchise Data Center"
+43 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="in Austin has changed the preferred address name for IFCAP communications"
+44 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="from FMS to VA FSC. This report lists any stations in your system that"
+45 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="do not have a MAIL INVOICE LOCATION starting with VA FSC. The necessity"
+46 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="for the address only applies to Stations/Substations that will be using"
+47 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="requisitions. You will need to make a local determination as to which"
+48 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="stations this applies to at your facility. Additionally, the report"
+49 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="lists addresses which contain the old FMS abbreviation. These could"
+50 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="be considered for editing or deletion. Again, this should be a local"
+51 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="determination that cannot be automated by this patch."
+52 SET PRCC=PRCC+1
SET PRCTXT(PRCC)=" "
+53 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="The following Stations/Substations do not have a VA FSC address entry"
+54 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="in the ADMIN. ACTIVITY SITE PARAMETER file."
+55 SET DA=0
+56 FOR
SET DA=$ORDER(PRCA(DA))
if DA=""
QUIT
if '$DATA(PRCA(DA,0))
QUIT
Begin DoDot:1
+57 SET PRCC=PRCC+1
+58 SET PRCTXT(PRCC)=$PIECE(^DIC(4,DA,99),U,1)
+59 KILL PRCA(DA,0)
End DoDot:1
+60 SET PRCC=PRCC+1
SET PRCTXT(PRCC)=" "
+61 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="The following Stations/Substations have an FMS address which may need"
+62 SET PRCC=PRCC+1
SET PRCTXT(PRCC)="to be edited."
+63 SET PRC1=0
+64 FOR
SET PRC1=$ORDER(PRCA(PRC1))
if PRC1=""
QUIT
Begin DoDot:1
+65 SET PRC2=0
+66 FOR
SET PRC2=$ORDER(PRCA(PRC1,PRC2))
if PRC2=""
QUIT
Begin DoDot:2
+67 SET PRCC=PRCC+1
+68 SET PRCTXT(PRCC)=$PIECE(^DIC(4,PRC1,99),U,1)_" "_PRCA(PRC1,PRC2)
End DoDot:2
End DoDot:1
+69 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.IBPARAM,"","")
+70 DO BMES^XPDUTL("Address validation complete, a MailMan message has been sent listing items")
+71 DO MES^XPDUTL("which may need to be reviewed.")
+72 QUIT
