XU8P135 ;SF/KLD - Post-Install for Reindexing File #200 Field #16 ;02/01/2000 09:35
;;8.0;KERNEL;**135**;Nov 26, 1999
;
; REINDEX
; This sub-routine will be used to Reindex the DIVISION field #16 of
; the NEW PERSON file #200. A new index was created "AH".
;
; REMOVE
; This sub-routine will be used to remove bogus X-Ref introduced
; at test sites for this patch.
;
EN ;
D REMOVE
D REINDEX
Q
;
REMOVE ;
D DELIX^DDMOD(200,.01,7)
D DELIX^DDMOD(200,53.5,1)
Q
;
REINDEX ;
W !,"Reindexing FILE 200, Field 16...."
N IEN,DIK,DA,NME
S (IEN,NME)=0
F S NME=$O(^VA(200,"B",NME)) Q:NME="" D
. F S IEN=$O(^VA(200,"B",NME,IEN)) Q:'IEN D
. . I $D(^VA(200,IEN,2,0))=1 D
. . . S DIK="^VA(200,"_IEN_",2,",DIK(1)=".01^AH",DA(1)=IEN
. . . D ENALL^DIK
W !,"Finished."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P135 816 printed Nov 22, 2024@17:17:09 Page 2
XU8P135 ;SF/KLD - Post-Install for Reindexing File #200 Field #16 ;02/01/2000 09:35
+1 ;;8.0;KERNEL;**135**;Nov 26, 1999
+2 ;
+3 ; REINDEX
+4 ; This sub-routine will be used to Reindex the DIVISION field #16 of
+5 ; the NEW PERSON file #200. A new index was created "AH".
+6 ;
+7 ; REMOVE
+8 ; This sub-routine will be used to remove bogus X-Ref introduced
+9 ; at test sites for this patch.
+10 ;
EN ;
+1 DO REMOVE
+2 DO REINDEX
+3 QUIT
+4 ;
REMOVE ;
+1 DO DELIX^DDMOD(200,.01,7)
+2 DO DELIX^DDMOD(200,53.5,1)
+3 QUIT
+4 ;
REINDEX ;
+1 WRITE !,"Reindexing FILE 200, Field 16...."
+2 NEW IEN,DIK,DA,NME
+3 SET (IEN,NME)=0
+4 FOR
SET NME=$ORDER(^VA(200,"B",NME))
if NME=""
QUIT
Begin DoDot:1
+5 FOR
SET IEN=$ORDER(^VA(200,"B",NME,IEN))
if 'IEN
QUIT
Begin DoDot:2
+6 IF $DATA(^VA(200,IEN,2,0))=1
Begin DoDot:3
+7 SET DIK="^VA(200,"_IEN_",2,"
SET DIK(1)=".01^AH"
SET DA(1)=IEN
+8 DO ENALL^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+9 WRITE !,"Finished."
+10 QUIT
