PRCAP276 ;OIFO-BAYPINES/RBN - PRE-INSTALL ROUTINE ;6/6/11 12:29pm
;;4.5;Accounts Receivable;**276**;Mar 20, 1995;Build 87
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; icr #1157 Authorizes use of $$DELETE^XPDMENU()
Q
PR ; Pre-install entry point
; Creates KIDS checkpoint with call back
N OPT,Y
F OPT="OPT" D
. S Y=$$NEWCP^XPDUTL(OPT,OPT_"^PRCAP276")
. I 'Y D BMES^XPDUTL("ERROR Creating "_OPT_" Checkpoint.")
Q
OPT ; pre-install to remove report from reports menu
N MENU,OPT
D BMES^XPDUTL(" Updating Menu...")
S MENU="RCDPE EDI LOCKBOX REPORTS MENU"
S OPT=$$DELETE^XPDMENU(MENU,"RCDPE DEPOSIT RECON REPORT")
; clear x-refs 'E' and 'G' if they are present
I $P($G(^RCY(344.4,0)),"^",4)=0 Q
E D
. I $D(^RCY(344.4,"G")) S DIK="^RCY(344.4,",DIK(1)=".04^G" D ENALL2^DIK K DIK ; clear index
. I $D(^RCY(344.4,"E")) S DIK="^RCY(344.4,",DIK(1)=".17^E" D ENALL2^DIK K DIK
Q
;
POST ; post-install to re-index fields #.04 and #.17 in file #344.4. The
; cross-ref 'AC' and 'AD' will be populated only if we find data.
I $P($G(^RCY(344.4,0)),"^",4)>0 D
. D BMES^XPDUTL("Indexing fields #.04 and #.17 in ELECTRONIC REMITTANCE ADVICE File #344.4")
. D WAIT^DICD
. S DIK="^RCY(344.4,",DIK(1)=".04^AC" D ENALL^DIK K DIK ; new index
. S DIK="^RCY(344.4,",DIK(1)=".17^AD" D ENALL^DIK K DIK
. D BMES^XPDUTL("<<< Indexing complete!")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP276 1408 printed Nov 22, 2024@16:50:49 Page 2
PRCAP276 ;OIFO-BAYPINES/RBN - PRE-INSTALL ROUTINE ;6/6/11 12:29pm
+1 ;;4.5;Accounts Receivable;**276**;Mar 20, 1995;Build 87
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; icr #1157 Authorizes use of $$DELETE^XPDMENU()
+5 QUIT
PR ; Pre-install entry point
+1 ; Creates KIDS checkpoint with call back
+2 NEW OPT,Y
+3 FOR OPT="OPT"
Begin DoDot:1
+4 SET Y=$$NEWCP^XPDUTL(OPT,OPT_"^PRCAP276")
+5 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_OPT_" Checkpoint.")
End DoDot:1
+6 QUIT
OPT ; pre-install to remove report from reports menu
+1 NEW MENU,OPT
+2 DO BMES^XPDUTL(" Updating Menu...")
+3 SET MENU="RCDPE EDI LOCKBOX REPORTS MENU"
+4 SET OPT=$$DELETE^XPDMENU(MENU,"RCDPE DEPOSIT RECON REPORT")
+5 ; clear x-refs 'E' and 'G' if they are present
+6 IF $PIECE($GET(^RCY(344.4,0)),"^",4)=0
QUIT
+7 IF '$TEST
Begin DoDot:1
+8 ; clear index
IF $DATA(^RCY(344.4,"G"))
SET DIK="^RCY(344.4,"
SET DIK(1)=".04^G"
DO ENALL2^DIK
KILL DIK
+9 IF $DATA(^RCY(344.4,"E"))
SET DIK="^RCY(344.4,"
SET DIK(1)=".17^E"
DO ENALL2^DIK
KILL DIK
End DoDot:1
+10 QUIT
+11 ;
POST ; post-install to re-index fields #.04 and #.17 in file #344.4. The
+1 ; cross-ref 'AC' and 'AD' will be populated only if we find data.
+2 IF $PIECE($GET(^RCY(344.4,0)),"^",4)>0
Begin DoDot:1
+3 DO BMES^XPDUTL("Indexing fields #.04 and #.17 in ELECTRONIC REMITTANCE ADVICE File #344.4")
+4 DO WAIT^DICD
+5 ; new index
SET DIK="^RCY(344.4,"
SET DIK(1)=".04^AC"
DO ENALL^DIK
KILL DIK
+6 SET DIK="^RCY(344.4,"
SET DIK(1)=".17^AD"
DO ENALL^DIK
KILL DIK
+7 DO BMES^XPDUTL("<<< Indexing complete!")
End DoDot:1
+8 QUIT
