Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCH135P

PRCH135P.m

Go to the documentation of this file.
  1. PRCH135P ;VMP/RB - FIX XREF 'RB' FOR DUPLCATE ENTRIES #410 ;03/09/09
  1. ;;5.1;IFCAP;**135**;02/09/09;Build 7
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;;
  1. Q
  1. FIX410 ;
  1. ;1. Post install to delete duplicate entries in x-rec 'RB' caused when
  1. ; using option [CHANGE EXISTING TRANSACTION NUMBER] or when editing
  1. ; incomplete orders to new FCP.
  1. ;
  1. BUILD K ^XTMP("PRCH135P") D NOW^%DTC S RMSTART=%
  1. S ^XTMP("PRCH135P","START COMPILE")=RMSTART
  1. S ^XTMP("PRCH135P","END COMPILE")="RUNNING"
  1. S ^XTMP("PRCH135P",0)=$$FMADD^XLFDT(RMSTART,120)_"^"_RMSTART
  1. 0 ;FIND DUPLICATE ENTRIES IN ^PRC(410,"RB") INDEX
  1. S REQNO="",IEN=0,U="^",DSH="-"
  1. 1 S REQNO=$O(^PRCS(410,"RB",REQNO)) G EXIT:REQNO=""!(REQNO]"@")
  1. 2 S IEN=$O(^PRCS(410,"RB",REQNO,IEN)) G 1:IEN=""
  1. ;BUILD 'RB' X-REF
  1. S R0=$G(^PRCS(410,IEN,0)) I R0="" S WDS="MISSING 0 NODE" G 3
  1. S R0REQ=$P(R0,U),QTRDT=$P(R0,U,11) G 2:QTRDT'>0
  1. S BREQ=QTRDT_DSH_$P(R0REQ,DSH)_DSH_$P(R0REQ,DSH,4)_DSH_$P(R0REQ,DSH,2)_DSH_$P(R0REQ,DSH,5)
  1. I REQNO=BREQ G 2
  1. S WDS="DUPLICATE RB" G 3
  1. G 2
  1. 3 S ^XTMP("PRCH135P",410,REQNO,IEN,0)=R0_";"_WDS
  1. K ^PRCS(410,"RB",REQNO,IEN)
  1. G 2
  1. EXIT ;
  1. D NOW^%DTC S RMEND=%
  1. S ^XTMP("PRCH135P","END COMPILE")=RMEND
  1. K RMEND,RMSTART,%,IEN,R0,REQNO,RBXREF,QTRDT,BREQ,DSH,R0REQ,WDS
  1. Q