PRCAP381.m

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 ---PRCAP381   1566     printed  Mar 13, 2025@20:45:29                                                                                                                                                                                                    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