PRCP185P ;RB-PRE INSTALL PRC*185 TO RE-INDEX FILE 445, FIELD .8 ;4-26-94/3:45 PM
V ;;5.1;IFCAP;**185**;Oct 20, 2000;Build 3
;Per VHA Directive 2004-038, this routine should not be modified.
Q
START ;PRC*5.1*185 Process to re-index file 445, field .8 [ABBREVIATED NAME]
; due to adding new CROSS REFERENCE ('CAB') to field.
;
K ^XTMP("PRCP185P")
D NOW^%DTC S RMSTART=%
S ^XTMP("PRCP185P","START COMPILE")=RMSTART
S ^XTMP("PRCP185P","END COMPILE")="RUNNING"
S ^XTMP("PRCP185P",0)=$$FMADD^XLFDT(RMSTART,180)_"^"_RMSTART
S PRCIEN=0
BB F S PRCIEN=$O(^PRCP(445,PRCIEN)) Q:'PRCIEN D
. Q:'$D(^PRCP(445,PRCIEN,0)) S DA=PRCIEN
. S PRCPR0=^PRCP(445,PRCIEN,0) S PRCABRV=$P(PRCPR0,"^",5) Q:PRCABRV=""
. S ^XTMP("PRCP185P",DA,PRCABRV)="" K DIC
. S DIK="^PRCP(445,",DIK(1)=".8^2" D EN^DIK K DIK
. S ^XTMP("PRCP185P",DA,PRCABRV,"CAB")=$S('$D(^PRCP(445,"CAB",PRCABRV,DA)):0,1:1)
D NOW^%DTC S RMEND=%
S ^XTMP("PRCP185P","END REINDEX")=RMEND
K %,RMSTART,RMEND,PRCIEN,PRCABRV,DA,PRCPR0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCP185P 1024 printed Dec 13, 2024@02:12:29 Page 2
PRCP185P ;RB-PRE INSTALL PRC*185 TO RE-INDEX FILE 445, FIELD .8 ;4-26-94/3:45 PM
V ;;5.1;IFCAP;**185**;Oct 20, 2000;Build 3
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 QUIT
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.
+2 ;
+3 KILL ^XTMP("PRCP185P")
+4 DO NOW^%DTC
SET RMSTART=%
+5 SET ^XTMP("PRCP185P","START COMPILE")=RMSTART
+6 SET ^XTMP("PRCP185P","END COMPILE")="RUNNING"
+7 SET ^XTMP("PRCP185P",0)=$$FMADD^XLFDT(RMSTART,180)_"^"_RMSTART
+8 SET PRCIEN=0
BB FOR
SET PRCIEN=$ORDER(^PRCP(445,PRCIEN))
if 'PRCIEN
QUIT
Begin DoDot:1
+1 if '$DATA(^PRCP(445,PRCIEN,0))
QUIT
SET DA=PRCIEN
+2 SET PRCPR0=^PRCP(445,PRCIEN,0)
SET PRCABRV=$PIECE(PRCPR0,"^",5)
if PRCABRV=""
QUIT
+3 SET ^XTMP("PRCP185P",DA,PRCABRV)=""
KILL DIC
+4 SET DIK="^PRCP(445,"
SET DIK(1)=".8^2"
DO EN^DIK
KILL DIK
+5 SET ^XTMP("PRCP185P",DA,PRCABRV,"CAB")=$SELECT('$DATA(^PRCP(445,"CAB",PRCABRV,DA)):0,1:1)
End DoDot:1
+6 DO NOW^%DTC
SET RMEND=%
+7 SET ^XTMP("PRCP185P","END REINDEX")=RMEND
+8 KILL %,RMSTART,RMEND,PRCIEN,PRCABRV,DA,PRCPR0
+9 QUIT
