ORPS503 ;HPS/DJH - Save data before rebuilding index OR*3.0*503 ;Jan 11, 2019@14:33
;;3.0;ORDER ENTRY/RESULTS REPORTING;**503**;Dec 17, 1997;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
Q ;
; This routine will save off the C index of file 100.9 and then rebuilding the C index
; OR*3.0*503 djh
;
EN ;
N DIK,ORNOT,ORIEN
; save existing C index
S ^XTMP("ORPS503",0)=$$FMADD^XLFDT(DT,730)_U_DT
S ORNOT=""
F S ORNOT=$O(^ORD(100.9,"C",ORNOT)) Q:ORNOT="" D
. S ORIEN=0
. F S ORIEN=$O(^ORD(100.9,"C",ORNOT,ORIEN)) Q:'ORIEN D
. . S ^XTMP("ORPS503",ORNOT,ORIEN)=""
; kill C index before rebuilding
K ^ORD(100.9,"C")
S DIK="^ORD(100.9,",DIK(1)=".02^C"
D ENALL^DIK ;rebuild the C x-ref
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPS503 754 printed Dec 13, 2024@02:33:01 Page 2
ORPS503 ;HPS/DJH - Save data before rebuilding index OR*3.0*503 ;Jan 11, 2019@14:33
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**503**;Dec 17, 1997;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
QUIT
+4 ; This routine will save off the C index of file 100.9 and then rebuilding the C index
+5 ; OR*3.0*503 djh
+6 ;
EN ;
+1 NEW DIK,ORNOT,ORIEN
+2 ; save existing C index
+3 SET ^XTMP("ORPS503",0)=$$FMADD^XLFDT(DT,730)_U_DT
+4 SET ORNOT=""
+5 FOR
SET ORNOT=$ORDER(^ORD(100.9,"C",ORNOT))
if ORNOT=""
QUIT
Begin DoDot:1
+6 SET ORIEN=0
+7 FOR
SET ORIEN=$ORDER(^ORD(100.9,"C",ORNOT,ORIEN))
if 'ORIEN
QUIT
Begin DoDot:2
+8 SET ^XTMP("ORPS503",ORNOT,ORIEN)=""
End DoDot:2
End DoDot:1
+9 ; kill C index before rebuilding
+10 KILL ^ORD(100.9,"C")
+11 SET DIK="^ORD(100.9,"
SET DIK(1)=".02^C"
+12 ;rebuild the C x-ref
DO ENALL^DIK
+13 QUIT
