PRCAP381 ;EDE/SAB - PRCA*4.5*381 POST INSTALL; 12/04/20
;;4.5;Accounts Receivable;**381**;Mar 20, 1995;Build 28
;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*381")
;
; Update the ATCS? field in Repayment Plans
D ATCS
;
D BMES^XPDUTL(" >> End of the Post-Installation routine for PRCA*4.5*381")
Q
;
ATCS ; review plans and update the AT CS flag associated with the plans.
;
D BMES^XPDUTL(" >> Reviewing the Repayment Plans Cross Servicing Flags")
;
N RCATCS,RCCSDT,RCCSRCDT,RCDATA,RCDBTR,RCIEN
;
S RCDBTR=0
F S RCDBTR=$O(^RCRP(340.5,"E",RCDBTR)) Q:'RCDBTR D
. S RCIEN=0
. S RCATCS=0
. F S RCIEN=$O(^RCRP(340.5,"E",RCDBTR,RCIEN)) Q:'RCIEN D Q:RCATCS
. . S RCSTAT=$$GET1^DIQ(340.5,RCIEN_",",.07,"I")
. . Q:RCSTAT>5
. . S (RCBILLDA,RCATCS)=0
. . ;Loop through all of the bills a Debtor has.
. . F S RCBILLDA=$O(^PRCA(430,"C",RCDBTR,RCBILLDA)) Q:'RCBILLDA D Q:RCATCS
. . . S RCCSDT=+$$GET1^DIQ(430,RCBILLDA_",",151,"I") ; get CS Date referral date
. . . S RCCSRCDT=+$$GET1^DIQ(430,RCBILLDA_",",153,"I") ; get CS Recall date
. . . Q:'RCCSDT ; Plan not at cross servicing
. . . Q:RCCSRCDT ; Plan was at Cross Servicing but is now recalled.
. . . S RCATCS=1
. . ;W RCIEN," - ",RCATCS,!
. . ;
. . ;Update the field.
. . D UPDATCS^RCRPU2(RCIEN,RCATCS)
D BMES^XPDUTL(" >> Review and updates if necessary of the Repayment Plans Cross Servicing Flags is completed.")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP381 1566 printed Nov 22, 2024@16:51:01 Page 2
PRCAP381 ;EDE/SAB - PRCA*4.5*381 POST INSTALL; 12/04/20
+1 ;;4.5;Accounts Receivable;**381**;Mar 20, 1995;Build 28
+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*381")
+2 ;
+3 ; Update the ATCS? field in Repayment Plans
+4 DO ATCS
+5 ;
+6 DO BMES^XPDUTL(" >> End of the Post-Installation routine for PRCA*4.5*381")
+7 QUIT
+8 ;
ATCS ; review plans and update the AT CS flag associated with the plans.
+1 ;
+2 DO BMES^XPDUTL(" >> Reviewing the Repayment Plans Cross Servicing Flags")
+3 ;
+4 NEW RCATCS,RCCSDT,RCCSRCDT,RCDATA,RCDBTR,RCIEN
+5 ;
+6 SET RCDBTR=0
+7 FOR
SET RCDBTR=$ORDER(^RCRP(340.5,"E",RCDBTR))
if 'RCDBTR
QUIT
Begin DoDot:1
+8 SET RCIEN=0
+9 SET RCATCS=0
+10 FOR
SET RCIEN=$ORDER(^RCRP(340.5,"E",RCDBTR,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:2
+11 SET RCSTAT=$$GET1^DIQ(340.5,RCIEN_",",.07,"I")
+12 if RCSTAT>5
QUIT
+13 SET (RCBILLDA,RCATCS)=0
+14 ;Loop through all of the bills a Debtor has.
+15 FOR
SET RCBILLDA=$ORDER(^PRCA(430,"C",RCDBTR,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:3
+16 ; get CS Date referral date
SET RCCSDT=+$$GET1^DIQ(430,RCBILLDA_",",151,"I")
+17 ; get CS Recall date
SET RCCSRCDT=+$$GET1^DIQ(430,RCBILLDA_",",153,"I")
+18 ; Plan not at cross servicing
if 'RCCSDT
QUIT
+19 ; Plan was at Cross Servicing but is now recalled.
if RCCSRCDT
QUIT
+20 SET RCATCS=1
End DoDot:3
if RCATCS
QUIT
+21 ;W RCIEN," - ",RCATCS,!
+22 ;
+23 ;Update the field.
+24 DO UPDATCS^RCRPU2(RCIEN,RCATCS)
End DoDot:2
if RCATCS
QUIT
End DoDot:1
+25 DO BMES^XPDUTL(" >> Review and updates if necessary of the Repayment Plans Cross Servicing Flags is completed.")
+26 ;
+27 QUIT
