PRC229.m

PRC229 ;HDSO/JAB - TRANSACTION UTILITY PROGRAM ; 27 FEB 2024

 ;;5.1;IFCAP;**229**;;Build 26

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 ; Reference to ^DIC in ICR #10006

 ; Reference to $$FIND1^DIC in ICR #2051

 ; Reference to UPDATE^DIE in ICR #2053

 ; Reference to $$SITE^VASITE in ICR #10112

 ; Reference to $$DT^XLFDT in ICR #10103

 ; Reference to $$FMADD^XLFDT in ICR #10103

 ; Reference to SENDMSG^XMXAPI in ICR #2729

 ; Reference to MES^XPDUTL in ICR #10141

 ; Reference to $$PROD^XUPROD in ICR #4440

 Q

EN ;Entry point to kill 0 site and 0 FCP entries from FUND CONTROL POINT file 420

 ;PRCPRVST - previous site

 ;PRCSITE - current site

 ;PRCFCP - FCP

 ;PRCCNT - Count of 0 nodes deleted

 ;PRCBKUP - Backup location of 0 nodes deleted

 N PRCPRVST,PRCSITE,PRCFCP,PRCCNT,PRCBKUP

 S U="^"

 S DT=$$DT^XLFDT

 I '$D(^XTMP("PRC229")) S ^XTMP("PRC229",0)=$$FMADD^XLFDT(DT,90)_U_DT

 S PRCSITE="" F  S PRCSITE=$O(^PRC(420,PRCSITE)) Q:PRCSITE=""  D

 . ;PRCMSG - Email message

 . ;PRCMESS - PRC message

 . ;PRCXTMP - ^XTMP message

 . ;PRCBDND - PRC bad node

 . ;PRCBDMSG - Bad node message

 . ;PRCMSGLN - Email message line number

 . ;This email info is not static and skips over static portions (PRCMSGLN=5) of email

 . N PRCMSG,PRCMESS,PRCXTMP,PRCBDND,PRCBDMSG,PRCMSGLN

 . S PRCMSGLN=5,PRCCNT=0,(PRCPRVST,PRCXTMP)=""

 . S PRCFCP="" F  S PRCFCP=$O(^PRC(420,PRCSITE,1,PRCFCP)) Q:PRCFCP=""  D

 . . I PRCPRVST'=PRCSITE  S PRCCNT=0,PRCPRVST=PRCSITE

 . . I PRCSITE=0 D

 . . . M ^XTMP("PRC229",DT,PRCSITE,1,PRCFCP)=^PRC(420,PRCSITE,1,PRCFCP)

 . . . K ^PRC(420,PRCSITE,1,PRCFCP)

 . . . S PRCMSG(PRCMSGLN)="     A SITE that was 0 that had an FCP of "_PRCFCP_"."

 . . . S PRCXTMP="backup in ^XTMP(PRC229,"_DT_","_PRCSITE_",1,"_PRCFCP_")."

 . . . S PRCBDND="     Deleted ^PRC(420,"_PRCSITE_",1,"_PRCFCP_")"

 . . . S PRCMSGLN=PRCMSGLN+1

 . . . S PRCCNT=PRCCNT+1

 . . . S PRCBDMSG(PRCCNT)=PRCBDND_"  "_PRCXTMP

 . . I (PRCSITE'=0),(PRCFCP=0),$D(^PRC(420,PRCSITE,1,PRCFCP,4))'=0  D

 . . . M ^XTMP("PRC229",DT,PRCSITE,1,PRCFCP,4)=^PRC(420,PRCSITE,1,PRCFCP,4)

 . . . K ^PRC(420,PRCSITE,1,PRCFCP,4)

 . . . S PRCMSG(PRCMSGLN)="     A FCP that was 0 for SITE "_PRCSITE_"."

 . . . S PRCXTMP="backup in ^XTMP(PRC229,"_DT_","_PRCSITE_",1,"_PRCFCP_",4)."

 . . . S PRCBDND="     Deleted ^PRC(420,"_PRCSITE_",1,"_PRCFCP_",4)"

 . . . S PRCMSGLN=PRCMSGLN+1

 . . . S PRCCNT=PRCCNT+1

 . . . S PRCBDMSG(PRCCNT)=PRCBDND_"  "_PRCXTMP

 . . . Q

 . . Q

 . I (PRCCNT>0) D EMAIL

 Q

EMAIL ;

 N PRCSUBJ,PRCSTA,PRCENVTP,XMTO,PRCBDCNT

 S PRCSUBJ="0 Site and/or FCP Deleted by Nightly Job in "_PRCSITE_"."  ;Must < 65 chars

 S PRCSUBJ=$TR($E(PRCSUBJ,1,65),U," ")

 S PRCSTA=$$SITE^VASITE

 S PRCENVTP=$S($$PROD^XUPROD(1):"PRODUCTION",1:"TEST")

 S PRCMSG(1)="Good morning,"

 S PRCMSG(2)=" "

 S PRCMSG(3)="When you receive this email, it indicates inaccessible data with a 0 site and/or 0 FCP was created in past 24 hours."

 S PRCMSG(3)=PRCMSG(3)_"  The nightly Delete Site/FCP=0 [PRC DELETE SITE/FCP=0] job that runs at 3:00 am found "

 S PRCMSG(4)="this data, made a backup of it, and deleted these entries:"

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)=" "

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)="Please contact your Budget Analyst team to ask what options they were using involving FCPs in the past 24 hours such"

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)="as Carry Forward Quarterly or Release Transaction, or any other activity related to FCP's and if they encountered any"

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)="FCP issues."

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)=" "

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)="Please submit a Service Now ticket after finding out details from the Budget Analyst team and include these findings"

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)="which the IT support team will require to research."

 F PRCBDCNT=1:1:PRCCNT S PRCMSGLN=PRCMSGLN+1,PRCMSG(PRCMSGLN)=PRCBDMSG(PRCBDCNT)

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)=" "

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)="We are attempting to identify and improve the IFCAP software functionality that causes these 0's to be created."

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)=" "

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)="Thank you."

 S PRCMSGLN=PRCMSGLN+1

 S PRCMSG(PRCMSGLN)=" "

 S PRCMSGLN=PRCMSGLN+1

 M PRCMSG=PRCMESS

 S XMTO("VHATUCPRC229Distribution@domain.ext")=""  ;wrapper email group   

 D SENDMSG^XMXAPI(DUZ,PRCSUBJ,"PRCMSG",.XMTO)

 Q

SCHED229 ;

 D MES^XPDUTL("Setting up TASKMAN scheduling.")

 N DA,DIC,DIE,DR,DT,FDA,DIIEN,DIMSGA,X,Y,PRCOPIEN,PRCSCIEN,PRCTOM

 S DT=$$DT^XLFDT()  ;Current Date in FM

 S X="PRC DELETE SITE/FCP=0"  ;OPTION NAME

 S DIC=19

 D ^DIC

 S FDA(19.2,"?+1,",.01)=+Y  ;IEN from DIC 19

 S FDA(19.2,"?+1,",2)=DT_".03"  ;Install date & daily run time

 S FDA(19.2,"?+1,",6)="1D"  ;Frequency every 1 day

 S FDA(19.2,"?+1,",11)=".5" ; Run as POSTMASTER

 D UPDATE^DIE(,"FDA","DIEN","DIMSGA")

 S PRCTOM=$$FMADD^XLFDT(DT,1) ;Add 1 day to FM date

 S PRCOPIEN=$$FIND1^DIC(19,"","OX","PRC DELETE SITE/FCP=0","B")

 S PRCSCIEN=$$FIND1^DIC(19.2,"","B","PRC DELETE SITE/FCP=0","B")

 I $P(^DIC(19,PRCOPIEN,0),U,1)="PRC DELETE SITE/FCP=0",PRCSCIEN'="" D 

 . D MES^XPDUTL("Option 'PRC DELETE SITE/FCP=0' is scheduled to start running on "_PRCTOM_" at 3 am.")

 . D MES^XPDUTL("It is "_PRCOPIEN_" in OPTION (#19) file and "_PRCSCIEN_" in OPTION SCHEDULING (#19.2) file.")

 Q 

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRC229   5479     printed  Mar 13, 2025@21:04:21                                                                                                                                                                                                      Page 2

PRC229    ;HDSO/JAB - TRANSACTION UTILITY PROGRAM ; 27 FEB 2024

 +1       ;;5.1;IFCAP;**229**;;Build 26

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; Reference to ^DIC in ICR #10006

 +5       ; Reference to $$FIND1^DIC in ICR #2051

 +6       ; Reference to UPDATE^DIE in ICR #2053

 +7       ; Reference to $$SITE^VASITE in ICR #10112

 +8       ; Reference to $$DT^XLFDT in ICR #10103

 +9       ; Reference to $$FMADD^XLFDT in ICR #10103

 +10      ; Reference to SENDMSG^XMXAPI in ICR #2729

 +11      ; Reference to MES^XPDUTL in ICR #10141

 +12      ; Reference to $$PROD^XUPROD in ICR #4440

 +13       QUIT 

EN        ;Entry point to kill 0 site and 0 FCP entries from FUND CONTROL POINT file 420

 +1       ;PRCPRVST - previous site

 +2       ;PRCSITE - current site

 +3       ;PRCFCP - FCP

 +4       ;PRCCNT - Count of 0 nodes deleted

 +5       ;PRCBKUP - Backup location of 0 nodes deleted

 +6        NEW PRCPRVST,PRCSITE,PRCFCP,PRCCNT,PRCBKUP

 +7        SET U="^"

 +8        SET DT=$$DT^XLFDT

 +9        IF '$DATA(^XTMP("PRC229"))

               SET ^XTMP("PRC229",0)=$$FMADD^XLFDT(DT,90)_U_DT

 +10       SET PRCSITE=""

           FOR 

               SET PRCSITE=$ORDER(^PRC(420,PRCSITE))

               if PRCSITE=""

                   QUIT 

               Begin DoDot:1

 +11      ;PRCMSG - Email message

 +12      ;PRCMESS - PRC message

 +13      ;PRCXTMP - ^XTMP message

 +14      ;PRCBDND - PRC bad node

 +15      ;PRCBDMSG - Bad node message

 +16      ;PRCMSGLN - Email message line number

 +17      ;This email info is not static and skips over static portions (PRCMSGLN=5) of email

 +18               NEW PRCMSG,PRCMESS,PRCXTMP,PRCBDND,PRCBDMSG,PRCMSGLN

 +19               SET PRCMSGLN=5

                   SET PRCCNT=0

                   SET (PRCPRVST,PRCXTMP)=""

 +20               SET PRCFCP=""

                   FOR 

                       SET PRCFCP=$ORDER(^PRC(420,PRCSITE,1,PRCFCP))

                       if PRCFCP=""

                           QUIT 

                       Begin DoDot:2

 +21                       IF PRCPRVST'=PRCSITE

                               SET PRCCNT=0

                               SET PRCPRVST=PRCSITE

 +22                       IF PRCSITE=0

                               Begin DoDot:3

 +23                               MERGE ^XTMP("PRC229",DT,PRCSITE,1,PRCFCP)=^PRC(420,PRCSITE,1,PRCFCP)

 +24                               KILL ^PRC(420,PRCSITE,1,PRCFCP)

 +25                               SET PRCMSG(PRCMSGLN)="     A SITE that was 0 that had an FCP of "_PRCFCP_"."

 +26                               SET PRCXTMP="backup in ^XTMP(PRC229,"_DT_","_PRCSITE_",1,"_PRCFCP_")."

 +27                               SET PRCBDND="     Deleted ^PRC(420,"_PRCSITE_",1,"_PRCFCP_")"

 +28                               SET PRCMSGLN=PRCMSGLN+1

 +29                               SET PRCCNT=PRCCNT+1

 +30                               SET PRCBDMSG(PRCCNT)=PRCBDND_"  "_PRCXTMP

                               End DoDot:3

 +31                       IF (PRCSITE'=0)

                               IF (PRCFCP=0)

                                   IF $DATA(^PRC(420,PRCSITE,1,PRCFCP,4))'=0

                                       Begin DoDot:3

 +32                                       MERGE ^XTMP("PRC229",DT,PRCSITE,1,PRCFCP,4)=^PRC(420,PRCSITE,1,PRCFCP,4)

 +33                                       KILL ^PRC(420,PRCSITE,1,PRCFCP,4)

 +34                                       SET PRCMSG(PRCMSGLN)="     A FCP that was 0 for SITE "_PRCSITE_"."

 +35                                       SET PRCXTMP="backup in ^XTMP(PRC229,"_DT_","_PRCSITE_",1,"_PRCFCP_",4)."

 +36                                       SET PRCBDND="     Deleted ^PRC(420,"_PRCSITE_",1,"_PRCFCP_",4)"

 +37                                       SET PRCMSGLN=PRCMSGLN+1

 +38                                       SET PRCCNT=PRCCNT+1

 +39                                       SET PRCBDMSG(PRCCNT)=PRCBDND_"  "_PRCXTMP

 +40                                       QUIT 

                                       End DoDot:3

 +41                       QUIT 

                       End DoDot:2

 +42               IF (PRCCNT>0)

                       DO EMAIL

               End DoDot:1

 +43       QUIT 

EMAIL     ;

 +1        NEW PRCSUBJ,PRCSTA,PRCENVTP,XMTO,PRCBDCNT

 +2       ;Must < 65 chars

           SET PRCSUBJ="0 Site and/or FCP Deleted by Nightly Job in "_PRCSITE_"."

 +3        SET PRCSUBJ=$TRANSLATE($EXTRACT(PRCSUBJ,1,65),U," ")

 +4        SET PRCSTA=$$SITE^VASITE

 +5        SET PRCENVTP=$SELECT($$PROD^XUPROD(1):"PRODUCTION",1:"TEST")

 +6        SET PRCMSG(1)="Good morning,"

 +7        SET PRCMSG(2)=" "

 +8        SET PRCMSG(3)="When you receive this email, it indicates inaccessible data with a 0 site and/or 0 FCP was created in past 24 hours."

 +9        SET PRCMSG(3)=PRCMSG(3)_"  The nightly Delete Site/FCP=0 [PRC DELETE SITE/FCP=0] job that runs at 3:00 am found "

 +10       SET PRCMSG(4)="this data, made a backup of it, and deleted these entries:"

 +11       SET PRCMSGLN=PRCMSGLN+1

 +12       SET PRCMSG(PRCMSGLN)=" "

 +13       SET PRCMSGLN=PRCMSGLN+1

 +14       SET PRCMSG(PRCMSGLN)="Please contact your Budget Analyst team to ask what options they were using involving FCPs in the past 24 hours such"

 +15       SET PRCMSGLN=PRCMSGLN+1

 +16       SET PRCMSG(PRCMSGLN)="as Carry Forward Quarterly or Release Transaction, or any other activity related to FCP's and if they encountered any"

 +17       SET PRCMSGLN=PRCMSGLN+1

 +18       SET PRCMSG(PRCMSGLN)="FCP issues."

 +19       SET PRCMSGLN=PRCMSGLN+1

 +20       SET PRCMSG(PRCMSGLN)=" "

 +21       SET PRCMSGLN=PRCMSGLN+1

 +22       SET PRCMSG(PRCMSGLN)="Please submit a Service Now ticket after finding out details from the Budget Analyst team and include these findings"

 +23       SET PRCMSGLN=PRCMSGLN+1

 +24       SET PRCMSG(PRCMSGLN)="which the IT support team will require to research."

 +25       FOR PRCBDCNT=1:1:PRCCNT

               SET PRCMSGLN=PRCMSGLN+1

               SET PRCMSG(PRCMSGLN)=PRCBDMSG(PRCBDCNT)

 +26       SET PRCMSGLN=PRCMSGLN+1

 +27       SET PRCMSG(PRCMSGLN)=" "

 +28       SET PRCMSGLN=PRCMSGLN+1

 +29       SET PRCMSG(PRCMSGLN)="We are attempting to identify and improve the IFCAP software functionality that causes these 0's to be created."

 +30       SET PRCMSGLN=PRCMSGLN+1

 +31       SET PRCMSG(PRCMSGLN)=" "

 +32       SET PRCMSGLN=PRCMSGLN+1

 +33       SET PRCMSG(PRCMSGLN)="Thank you."

 +34       SET PRCMSGLN=PRCMSGLN+1

 +35       SET PRCMSG(PRCMSGLN)=" "

 +36       SET PRCMSGLN=PRCMSGLN+1

 +37       MERGE PRCMSG=PRCMESS

 +38      ;wrapper email group   

           SET XMTO("VHATUCPRC229Distribution@domain.ext")=""

 +39       DO SENDMSG^XMXAPI(DUZ,PRCSUBJ,"PRCMSG",.XMTO)

 +40       QUIT 

SCHED229  ;

 +1        DO MES^XPDUTL("Setting up TASKMAN scheduling.")

 +2        NEW DA,DIC,DIE,DR,DT,FDA,DIIEN,DIMSGA,X,Y,PRCOPIEN,PRCSCIEN,PRCTOM

 +3       ;Current Date in FM

           SET DT=$$DT^XLFDT()

 +4       ;OPTION NAME

           SET X="PRC DELETE SITE/FCP=0"

 +5        SET DIC=19

 +6        DO ^DIC

 +7       ;IEN from DIC 19

           SET FDA(19.2,"?+1,",.01)=+Y

 +8       ;Install date & daily run time

           SET FDA(19.2,"?+1,",2)=DT_".03"

 +9       ;Frequency every 1 day

           SET FDA(19.2,"?+1,",6)="1D"

 +10      ; Run as POSTMASTER

           SET FDA(19.2,"?+1,",11)=".5"

 +11       DO UPDATE^DIE(,"FDA","DIEN","DIMSGA")

 +12      ;Add 1 day to FM date

           SET PRCTOM=$$FMADD^XLFDT(DT,1)

 +13       SET PRCOPIEN=$$FIND1^DIC(19,"","OX","PRC DELETE SITE/FCP=0","B")

 +14       SET PRCSCIEN=$$FIND1^DIC(19.2,"","B","PRC DELETE SITE/FCP=0","B")

 +15       IF $PIECE(^DIC(19,PRCOPIEN,0),U,1)="PRC DELETE SITE/FCP=0"

               IF PRCSCIEN'=""

                   Begin DoDot:1

 +16                   DO MES^XPDUTL("Option 'PRC DELETE SITE/FCP=0' is scheduled to start running on "_PRCTOM_" at 3 am.")

 +17                   DO MES^XPDUTL("It is "_PRCOPIEN_" in OPTION (#19) file and "_PRCSCIEN_" in OPTION SCHEDULING (#19.2) file.")

                   End DoDot:1

 +18       QUIT