PRCAP335 ;OAK/ELZ - Pre-install routine for patch PRCA*4.5*335 ;11/15/2017
;;4.5;Accounts Receivable;**335**;Mar 20, 1995;Build 8
;;Per VA Directive 6402, this routine should not be modified.
;
; This pre-install is a double check that an old AR file that should have been deleted
; a long time ago is actually not there before install of a new file (same number 430.7)
;
;
PRE ; Entry point to check for an old file and if there remove it
; before the install starts
;
N PRCAX
I $P($G(^PRCA(430.7,0)),"^")="AR BILLING ERROR HANDLING" D
. N DU,DA,DIK
. D MES^XPDUTL(" It appears you have an old 430.7 file that shouldn't be there.")
. D MES^XPDUTL(" - deleting before install.")
. ; just because the data clean up doesn't work well, there are not that many entries anyway
. S PRCAX=0 F S PRCAX=$O(^PRCA(430.7,PRCAX)) Q:'PRCAX S DIK="^PRCA(430.7,",DA=PRCAX D ^DIK
. S DU="^PRCA(430.7,",DU(0)="DET"
. D EN^DIU2
. D MES^XPDUTL(" Finished old file cleaned up.")
S PRCAX=$O(^PRCA(430.7,0)) I PRCAX,'$G(^PRCA(430.7,PRCAX,0)) D
. D MES^XPDUTL(" Need to clean up some old data...")
. K ^PRCA(430.7)
. S ^PRCA(430.7,0)="AR DEBT COLLECTOR DATA^430.7D^^0"
. D MES^XPDUTL(" Finished cleaning up old data.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP335 1257 printed Dec 13, 2024@01:40:41 Page 2
PRCAP335 ;OAK/ELZ - Pre-install routine for patch PRCA*4.5*335 ;11/15/2017
+1 ;;4.5;Accounts Receivable;**335**;Mar 20, 1995;Build 8
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This pre-install is a double check that an old AR file that should have been deleted
+5 ; a long time ago is actually not there before install of a new file (same number 430.7)
+6 ;
+7 ;
PRE ; Entry point to check for an old file and if there remove it
+1 ; before the install starts
+2 ;
+3 NEW PRCAX
+4 IF $PIECE($GET(^PRCA(430.7,0)),"^")="AR BILLING ERROR HANDLING"
Begin DoDot:1
+5 NEW DU,DA,DIK
+6 DO MES^XPDUTL(" It appears you have an old 430.7 file that shouldn't be there.")
+7 DO MES^XPDUTL(" - deleting before install.")
+8 ; just because the data clean up doesn't work well, there are not that many entries anyway
+9 SET PRCAX=0
FOR
SET PRCAX=$ORDER(^PRCA(430.7,PRCAX))
if 'PRCAX
QUIT
SET DIK="^PRCA(430.7,"
SET DA=PRCAX
DO ^DIK
+10 SET DU="^PRCA(430.7,"
SET DU(0)="DET"
+11 DO EN^DIU2
+12 DO MES^XPDUTL(" Finished old file cleaned up.")
End DoDot:1
+13 SET PRCAX=$ORDER(^PRCA(430.7,0))
IF PRCAX
IF '$GET(^PRCA(430.7,PRCAX,0))
Begin DoDot:1
+14 DO MES^XPDUTL(" Need to clean up some old data...")
+15 KILL ^PRCA(430.7)
+16 SET ^PRCA(430.7,0)="AR DEBT COLLECTOR DATA^430.7D^^0"
+17 DO MES^XPDUTL(" Finished cleaning up old data.")
End DoDot:1
+18 QUIT
