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 ---[H[J[2J[HPRCAP378 2110 printed Dec 13, 2024@01:40:48 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
