PRCAP378.m

PRCAP378 ;EDE/SAB - PRCA*4.5*378 POST INSTALL;02/11/21

 ;;4.5;Accounts Receivable;**378**;Mar 20, 1995;Build 54

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

 Q

 ;

EN ; entry point

 D BMES^XPDUTL(" >>  Start of the Post-Installation routine for PRCA*4.5*378")

 D UPCAT

 D UPDPAR

 D UPDAUTO

 D UPDBILL

 D BMES^XPDUTL(" >>  End of the Post-Installation routine for PRCA*4.5*378")

 Q

 ;

UPCAT ; update field 1.06 in the AR Category file for "NURSING HOME PROCEEDS" category

 N CAT,FDA

 D MES^XPDUTL("Updating ELIG FOR RPP field for 'NURSING HOME PROCEEDS' AR Category ... ")

 S CAT=+$O(^PRCA(430.2,"B","NURSING HOME PROCEEDS","")) Q:CAT'>0

 S FDA(430.2,CAT_",",1.06)=0

 D FILE^DIE("","FDA")

 D MES^XPDUTL("   Done.")

 Q

 ;

UPDPAR ; update field .16 in the AR SITE PARAMETER file 

 N CAT,FDA

 D MES^XPDUTL("Updating METRICS RETENTION DAYS field in the AR SITE PARAMETER file ... ")

 S FDA(342,"1,",.16)=180

 D FILE^DIE("","FDA")

 D MES^XPDUTL("   Done.")

 Q

 ;

UPDAUTO ;Update the Auto Add Field to set all active plans to Yes

 ;

 N RCI,RCDATA,RCSTAT     ; RPP variables

 N X,Y,DIE,DA,DR,DTOUT   ; ^DIE variables

 D MES^XPDUTL("Activating New Bill AUTO ADD functionality for all active Repayment Plans ... ")

 S RCI=0

 F  S RCI=$O(^RCRP(340.5,RCI)) Q:'RCI  D

 .  S RCDATA=$G(^RCRP(340.5,RCI,0))

 .  S RCSTAT=$P(RCDATA,U,7)

 .  Q:RCSTAT<6    ;status is not Terminated, Closed, or PAID IN FULL

 .  ; Update the Auto-Add flag

 .  S DIE="^RCRP(340.5,",DA=RCI,DR=".12///1"

 .  D ^DIE

 .  K DR,DA,DIE

 ;

 Q

 ;

UPDBILL ; Update all billes associated with a new RPP that is in a closed state, but RPP info is still in the bill.

 ;

 N RCI,RCD4,RCRPID,RCRPST    ; Routine Variables

 N X,Y,DIE,DA,DR,DTOUT       ; ^DIE variables

 S RCI=0

 F  S RCI=$O(^PRCA(430,RCI)) Q:'RCI  D

 .  S RCD4=$G(^PRCA(430,RCI,4))

 .  S RCRPID=$P(RCD4,U,5)

 .  Q:RCRPID=""     ;Bill not linked to a new style Repayment Plan

 .  S RCRPST=$$GET1^DIQ(340.5,RCRPID_",",.07,"I")

 .  Q:RCRPST<6

 .  S DIE="^PRCA(430,",DA=RCI,DR="45///@;41///@"

 .  D ^DIE

 .  K DR,DA,DIE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCAP378   2110     printed  Apr 23, 2025@17:55:15                                                                                                                                                                                                    Page 2

PRCAP378  ;EDE/SAB - PRCA*4.5*378 POST INSTALL;02/11/21

 +1       ;;4.5;Accounts Receivable;**378**;Mar 20, 1995;Build 54

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

 +3        QUIT 

 +4       ;

EN        ; entry point

 +1        DO BMES^XPDUTL(" >>  Start of the Post-Installation routine for PRCA*4.5*378")

 +2        DO UPCAT

 +3        DO UPDPAR

 +4        DO UPDAUTO

 +5        DO UPDBILL

 +6        DO BMES^XPDUTL(" >>  End of the Post-Installation routine for PRCA*4.5*378")

 +7        QUIT 

 +8       ;

UPCAT     ; update field 1.06 in the AR Category file for "NURSING HOME PROCEEDS" category

 +1        NEW CAT,FDA

 +2        DO MES^XPDUTL("Updating ELIG FOR RPP field for 'NURSING HOME PROCEEDS' AR Category ... ")

 +3        SET CAT=+$ORDER(^PRCA(430.2,"B","NURSING HOME PROCEEDS",""))

           if CAT'>0

               QUIT 

 +4        SET FDA(430.2,CAT_",",1.06)=0

 +5        DO FILE^DIE("","FDA")

 +6        DO MES^XPDUTL("   Done.")

 +7        QUIT 

 +8       ;

UPDPAR    ; update field .16 in the AR SITE PARAMETER file 

 +1        NEW CAT,FDA

 +2        DO MES^XPDUTL("Updating METRICS RETENTION DAYS field in the AR SITE PARAMETER file ... ")

 +3        SET FDA(342,"1,",.16)=180

 +4        DO FILE^DIE("","FDA")

 +5        DO MES^XPDUTL("   Done.")

 +6        QUIT 

 +7       ;

UPDAUTO   ;Update the Auto Add Field to set all active plans to Yes

 +1       ;

 +2       ; RPP variables

           NEW RCI,RCDATA,RCSTAT

 +3       ; ^DIE variables

           NEW X,Y,DIE,DA,DR,DTOUT

 +4        DO MES^XPDUTL("Activating New Bill AUTO ADD functionality for all active Repayment Plans ... ")

 +5        SET RCI=0

 +6        FOR 

               SET RCI=$ORDER(^RCRP(340.5,RCI))

               if 'RCI

                   QUIT 

               Begin DoDot:1

 +7                SET RCDATA=$GET(^RCRP(340.5,RCI,0))

 +8                SET RCSTAT=$PIECE(RCDATA,U,7)

 +9       ;status is not Terminated, Closed, or PAID IN FULL

                   if RCSTAT<6

                       QUIT 

 +10      ; Update the Auto-Add flag

 +11               SET DIE="^RCRP(340.5,"

                   SET DA=RCI

                   SET DR=".12///1"

 +12               DO ^DIE

 +13               KILL DR,DA,DIE

               End DoDot:1

 +14      ;

 +15       QUIT 

 +16      ;

UPDBILL   ; Update all billes associated with a new RPP that is in a closed state, but RPP info is still in the bill.

 +1       ;

 +2       ; Routine Variables

           NEW RCI,RCD4,RCRPID,RCRPST

 +3       ; ^DIE variables

           NEW X,Y,DIE,DA,DR,DTOUT

 +4        SET RCI=0

 +5        FOR 

               SET RCI=$ORDER(^PRCA(430,RCI))

               if 'RCI

                   QUIT 

               Begin DoDot:1

 +6                SET RCD4=$GET(^PRCA(430,RCI,4))

 +7                SET RCRPID=$PIECE(RCD4,U,5)

 +8       ;Bill not linked to a new style Repayment Plan

                   if RCRPID=""

                       QUIT 

 +9                SET RCRPST=$$GET1^DIQ(340.5,RCRPID_",",.07,"I")

 +10               if RCRPST<6

                       QUIT 

 +11               SET DIE="^PRCA(430,"

                   SET DA=RCI

                   SET DR="45///@;41///@"

 +12               DO ^DIE

 +13               KILL DR,DA,DIE

               End DoDot:1

 +14       QUIT