- 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 Feb 18, 2025@23:38:51 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