ASUP42T2.m

ASUP42T2 ; 06/05/2000  2:49 PM ]  

 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 ;

 ;****************************************************************

 ;***** This subroutine will reactivate the following options *******

 ;***** ASU03JCPBO,ASU527SDRP,ASU5270DRP,ASU5271DRP,ASU5173DRP ***

 ;************ ASU826PPIB, ASU024TRCT & ASU036TISS *************** 

 ;****************************************************************

FIXOPTNS ;

 S DIE="^DIC(19,"             ;Set up option file

 S ASUMENU=0

 F  S ASUMENU=$O(^DIC(19,ASUMENU)) S TEMP=^DIC(19,ASUMENU,0) Q:'ASUMENU  D

 .I ($P(TEMP,U)="ASU024TRCT")!($P(TEMP,U)="ASU03JCPBO")!($P(TEMP,U)="ASU5270DRP")!($P(TEMP,U)="ASU527SDRP")!($P(TEMP,U)="ASU5271DRP")!($P(TEMP,U)="ASU5173DRP")!($P(TEMP,U)="ASU826PPIB")!($P(TEMP,U)="ASU034TISS")!($P(TEMP,U)="ASU036TISS")  D

 ..I $P(TEMP,U,3)'=""  D

 ...S DA=ASUMENU

 ...S DR="2///@"

 ...D ^DIE

FIXHIST ;

 ;***************************************************************

 ;*** This subroutine will delete and reindex the corrupt******** 

 ;*********************** ASUH records. *************************

 ;***************************************************************

 ;

 S ASUHCRPT=0

 F  S ASUHCRPT=$O(^ASUH(ASUHCRPT)) Q:'ASUHCRPT  D

 .I ASUHCRPT["." S DA=ASUHCRPT,DIK="^ASUH(" D ^DIK

ASUP42T2  ; 06/05/2000  2:49 PM ]  

 +1       ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 +2       ;

 +3       ;****************************************************************

 +4       ;***** This subroutine will reactivate the following options *******

 +5       ;***** ASU03JCPBO,ASU527SDRP,ASU5270DRP,ASU5271DRP,ASU5173DRP ***

 +6       ;************ ASU826PPIB, ASU024TRCT & ASU036TISS *************** 

 +7       ;****************************************************************

FIXOPTNS  ;

 +1       ;Set up option file

           SET DIE="^DIC(19,"

 +2        SET ASUMENU=0

 +3        FOR 

               SET ASUMENU=$ORDER(^DIC(19,ASUMENU))

               SET TEMP=^DIC(19,ASUMENU,0)

               IF 'ASUMENU

                   QUIT 

               Begin DoDot:1

 +4               IF ($PIECE(TEMP,U)="ASU024TRCT")!($PIECE(TEMP,U)="ASU03JCPBO")!($PIECE(TEMP,U)="ASU5270DRP")!($PIECE(TEMP,U)="ASU527SDRP")!(...

                   ... $PIECE(TEMP,U)="ASU5271DRP")!($PIECE(TEMP,U)="ASU5173DRP")!($PIECE(TEMP,U)="ASU826PPIB")!($PIECE(TEMP,U)="ASU034TISS")!($PIECE(TEMP,U)="ASU036TISS")

                       Begin DoDot:2

 +5                        IF $PIECE(TEMP,U,3)'=""

                               Begin DoDot:3

 +6                                SET DA=ASUMENU

 +7                                SET DR="2///@"

 +8                                DO ^DIE

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

FIXHIST   ;

 +1       ;***************************************************************

 +2       ;*** This subroutine will delete and reindex the corrupt******** 

 +3       ;*********************** ASUH records. *************************

 +4       ;***************************************************************

 +5       ;

 +6        SET ASUHCRPT=0

 +7        FOR 

               SET ASUHCRPT=$ORDER(^ASUH(ASUHCRPT))

               IF 'ASUHCRPT

                   QUIT 

               Begin DoDot:1

 +8                IF ASUHCRPT["."

                       SET DA=ASUHCRPT

                       SET DIK="^ASUH("

                       DO ^DIK

               End DoDot:1