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 ---[H[J[2J[HRMPRWOFX 586 printed Dec 13, 2024@02:38:04 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
