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

PRCP185P.m

Go to the documentation of this file.
  1. PRCP185P ;RB-PRE INSTALL PRC*185 TO RE-INDEX FILE 445, FIELD .8 ;4-26-94/3:45 PM
  1. V ;;5.1;IFCAP;**185**;Oct 20, 2000;Build 3
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. START ;PRC*5.1*185 Process to re-index file 445, field .8 [ABBREVIATED NAME]
  1. ; due to adding new CROSS REFERENCE ('CAB') to field.
  1. ;
  1. K ^XTMP("PRCP185P")
  1. D NOW^%DTC S RMSTART=%
  1. S ^XTMP("PRCP185P","START COMPILE")=RMSTART
  1. S ^XTMP("PRCP185P","END COMPILE")="RUNNING"
  1. S ^XTMP("PRCP185P",0)=$$FMADD^XLFDT(RMSTART,180)_"^"_RMSTART
  1. S PRCIEN=0
  1. BB F S PRCIEN=$O(^PRCP(445,PRCIEN)) Q:'PRCIEN D
  1. . Q:'$D(^PRCP(445,PRCIEN,0)) S DA=PRCIEN
  1. . S PRCPR0=^PRCP(445,PRCIEN,0) S PRCABRV=$P(PRCPR0,"^",5) Q:PRCABRV=""
  1. . S ^XTMP("PRCP185P",DA,PRCABRV)="" K DIC
  1. . S DIK="^PRCP(445,",DIK(1)=".8^2" D EN^DIK K DIK
  1. . S ^XTMP("PRCP185P",DA,PRCABRV,"CAB")=$S('$D(^PRCP(445,"CAB",PRCABRV,DA)):0,1:1)
  1. D NOW^%DTC S RMEND=%
  1. S ^XTMP("PRCP185P","END REINDEX")=RMEND
  1. K %,RMSTART,RMEND,PRCIEN,PRCABRV,DA,PRCPR0
  1. Q