ORPS503.m

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 ---ORPS503   754     printed  Apr 09, 2024@21:26:19                                                                                                                                                                                                      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