RMPRWOFX.m

RMPRWOFX ;HOIFO/SPS - PRE-INIT PROSTHETICS WO FILE FIX ;08/24/06

 ;;3.0;Prosthetics;**75**;Feb 09, 1996;Build 25

 ;

 ; Fix to check for installation of patch 75 then delete 

 ; erroneous data in file 664.1 8th piece that might have been

 ; left over from 1994-95

EN ;

 N RMPRP,RMPRIEN

 S RMPRP=$$PATCH^XPDUTL("RMPR*3.0*75")

 I RMPRP=1 Q  ;Stop if 75 is installed

 ;

 S RMPRIEN=""

 F  S RMPRIEN=$O(^RMPR(664.1,RMPRIEN)) Q:RMPRIEN=""  D

 .Q:'$D(^RMPR(664.1,RMPRIEN,0))

 .Q:+$P(^RMPR(664.1,RMPRIEN,0),U)>2961231

 .I $P(^RMPR(664.1,RMPRIEN,0),U,8)'="" S $P(^(0),U,8)=""

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRWOFX   586     printed  Apr 09, 2024@21:34:36                                                                                                                                                                                                     Page 2

RMPRWOFX  ;HOIFO/SPS - PRE-INIT PROSTHETICS WO FILE FIX ;08/24/06

 +1       ;;3.0;Prosthetics;**75**;Feb 09, 1996;Build 25

 +2       ;

 +3       ; Fix to check for installation of patch 75 then delete 

 +4       ; erroneous data in file 664.1 8th piece that might have been

 +5       ; left over from 1994-95

EN        ;

 +1        NEW RMPRP,RMPRIEN

 +2        SET RMPRP=$$PATCH^XPDUTL("RMPR*3.0*75")

 +3       ;Stop if 75 is installed

           IF RMPRP=1

               QUIT 

 +4       ;

 +5        SET RMPRIEN=""

 +6        FOR 

               SET RMPRIEN=$ORDER(^RMPR(664.1,RMPRIEN))

               if RMPRIEN=""

                   QUIT 

               Begin DoDot:1

 +7                if '$DATA(^RMPR(664.1,RMPRIEN,0))

                       QUIT 

 +8                if +$PIECE(^RMPR(664.1,RMPRIEN,0),U)>2961231

                       QUIT 

 +9                IF $PIECE(^RMPR(664.1,RMPRIEN,0),U,8)'=""

                       SET $PIECE(^(0),U,8)=""

               End DoDot:1

 +10       QUIT