- 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 Apr 23, 2025@18:14:05 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
