PRCAP391.m

PRCAP391 ;EDE/YMG - PRCA*4.5*391 POST INSTALL; 10/01/21

 ;;4.5;Accounts Receivable;**391**;Mar 20, 1995;Build 10

 ;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*391")

 ; Update suspension types in file 433

 D UPDSTYPE

 ;

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

 Q

 ;

UPDSTYPE ; Update suspension types (field 433/90.1) in file 433

 N FDA,IENS,N1,STPTR,STYPE,TRIEN

 D BMES^XPDUTL(" >>  Updating suspension types in file 433...")

 S TRIEN=0 F  S TRIEN=$O(^PRCA(433,TRIEN)) Q:'TRIEN  D

 .S N1=$G(^PRCA(433,TRIEN,1)) I N1="" Q

 .S STYPE=$P(N1,U,11) I STYPE="" Q

 .S STPTR=+$O(^PRCA(433.001,"B",STYPE,"")) I STPTR'>0 Q

 .S IENS=TRIEN_",",FDA(433,IENS,90.1)=STPTR D FILE^DIE("","FDA")

 .Q

 D MES^XPDUTL("Done.")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCAP391   880     printed  Apr 09, 2024@20:46:58                                                                                                                                                                                                     Page 2

PRCAP391  ;EDE/YMG - PRCA*4.5*391 POST INSTALL; 10/01/21

 +1       ;;4.5;Accounts Receivable;**391**;Mar 20, 1995;Build 10

 +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*391")

 +2       ; Update suspension types in file 433

 +3        DO UPDSTYPE

 +4       ;

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

 +6        QUIT 

 +7       ;

UPDSTYPE  ; Update suspension types (field 433/90.1) in file 433

 +1        NEW FDA,IENS,N1,STPTR,STYPE,TRIEN

 +2        DO BMES^XPDUTL(" >>  Updating suspension types in file 433...")

 +3        SET TRIEN=0

           FOR 

               SET TRIEN=$ORDER(^PRCA(433,TRIEN))

               if 'TRIEN

                   QUIT 

               Begin DoDot:1

 +4                SET N1=$GET(^PRCA(433,TRIEN,1))

                   IF N1=""

                       QUIT 

 +5                SET STYPE=$PIECE(N1,U,11)

                   IF STYPE=""

                       QUIT 

 +6                SET STPTR=+$ORDER(^PRCA(433.001,"B",STYPE,""))

                   IF STPTR'>0

                       QUIT 

 +7                SET IENS=TRIEN_","

                   SET FDA(433,IENS,90.1)=STPTR

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

 +8                QUIT 

               End DoDot:1

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

 +10       QUIT