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 ---[H[J[2J[HPRCAP391 880 printed Dec 13, 2024@01:40:52 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
