PRCAP389 ;EDE/YMG - PRCA*4.5*389 POST INSTALL; 07/28/21
;;4.5;Accounts Receivable;**389**;Mar 20, 1995;Build 36
;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*389")
; Update audit log comments in file 340.5
D UPDCMNT
;
D BMES^XPDUTL(" >> End of the Post-Installation routine for PRCA*4.5*389")
Q
;
UPDCMNT ; Update audit log comments and 36 months review flag (fields 340.54/4 and 340.5/1.06) in file 340.5
N AIEN,APPR36,CMNT,CMNTPTR,FDA,IENS,RPIEN,RPPLEN
D BMES^XPDUTL(" >> Updating audit log comments and 36 months review flag in file 340.5...")
S RPIEN=0 F S RPIEN=$O(^RCRP(340.5,RPIEN)) Q:'RPIEN D
.S APPR36=0
.S RPPLEN=$P(^RCRP(340.5,RPIEN,0),U,5)
.S AIEN=0 F S AIEN=$O(^RCRP(340.5,RPIEN,4,AIEN)) Q:'AIEN D
..S CMNT=$P(^RCRP(340.5,RPIEN,4,AIEN,0),U,4) I CMNT="" Q
..I CMNT="SM" S APPR36=1
..S CMNTPTR=+$O(^RCRP(340.501,"B",CMNT,"")) I CMNTPTR'>0 Q
..S IENS=AIEN_","_RPIEN_",",FDA(340.54,IENS,5)=CMNTPTR D FILE^DIE("","FDA")
..Q
.; set field 340.5/1.06, if necessary
.I RPPLEN>36 S IENS=RPIEN_"," I $$GET1^DIQ(340.5,IENS,1.06,"I")="" S FDA(340.5,IENS,1.06)=APPR36 D FILE^DIE("","FDA")
.Q
D MES^XPDUTL("Done.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP389 1286 printed Dec 13, 2024@01:40:51 Page 2
PRCAP389 ;EDE/YMG - PRCA*4.5*389 POST INSTALL; 07/28/21
+1 ;;4.5;Accounts Receivable;**389**;Mar 20, 1995;Build 36
+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*389")
+2 ; Update audit log comments in file 340.5
+3 DO UPDCMNT
+4 ;
+5 DO BMES^XPDUTL(" >> End of the Post-Installation routine for PRCA*4.5*389")
+6 QUIT
+7 ;
UPDCMNT ; Update audit log comments and 36 months review flag (fields 340.54/4 and 340.5/1.06) in file 340.5
+1 NEW AIEN,APPR36,CMNT,CMNTPTR,FDA,IENS,RPIEN,RPPLEN
+2 DO BMES^XPDUTL(" >> Updating audit log comments and 36 months review flag in file 340.5...")
+3 SET RPIEN=0
FOR
SET RPIEN=$ORDER(^RCRP(340.5,RPIEN))
if 'RPIEN
QUIT
Begin DoDot:1
+4 SET APPR36=0
+5 SET RPPLEN=$PIECE(^RCRP(340.5,RPIEN,0),U,5)
+6 SET AIEN=0
FOR
SET AIEN=$ORDER(^RCRP(340.5,RPIEN,4,AIEN))
if 'AIEN
QUIT
Begin DoDot:2
+7 SET CMNT=$PIECE(^RCRP(340.5,RPIEN,4,AIEN,0),U,4)
IF CMNT=""
QUIT
+8 IF CMNT="SM"
SET APPR36=1
+9 SET CMNTPTR=+$ORDER(^RCRP(340.501,"B",CMNT,""))
IF CMNTPTR'>0
QUIT
+10 SET IENS=AIEN_","_RPIEN_","
SET FDA(340.54,IENS,5)=CMNTPTR
DO FILE^DIE("","FDA")
+11 QUIT
End DoDot:2
+12 ; set field 340.5/1.06, if necessary
+13 IF RPPLEN>36
SET IENS=RPIEN_","
IF $$GET1^DIQ(340.5,IENS,1.06,"I")=""
SET FDA(340.5,IENS,1.06)=APPR36
DO FILE^DIE("","FDA")
+14 QUIT
End DoDot:1
+15 DO MES^XPDUTL("Done.")
+16 QUIT
