RMPR61PG ;OIFO HINES/AA-PURGE 661.2 PROS STOCK ITEM RECORD FILE ;04/16/05
;;3.0;PROSTHETICS;**107**;04/16/05
;
; This routine used to remove records from Global RMPR(661.2
; and remove the pointers to RMPR(661.2 from Global
; RMPR(660 field 4.6 to reduce the install time for Patch RMPR*3*61
;
;
EN ;
; Check for installed RMPR*3.0*61 sites ** DO NOT CONTINUE PROCESS
; Patch 61 creates global #661.6
;
I '$D(^RMPR(661.6,0)) D BACKUP D UPDATE G EXIT Q
Q
;
UPDATE ;
; Processing for non-installed RMPR*3.0*61 sites ** CONTINE TO PROCESS
;
S RMPRIEN=0,(RMPRDAT,RMPRORDT)=""
D NOW^%DTC S RMPRYR=X-0020000,RMPRDAT=X
;
; RMPRYR = used to determine entries 2 years or more prior to
; today's date
; RMPRIEN = Internal Entry Number for records in RMPR(660
; RMPRNODE = Store the one (1) node for the selected record
; RMPRPNTR = Pointer to record IEN in Global RMPR(661.2
; RMPRREC = Store the zero Node of the RMPR(661.2 Record
; RMPRDAT = Record Date used to identify records 2+ years from
; today's date.
;
F S RMPRIEN=$O(^RMPR(660,RMPRIEN)) G:RMPRIEN'>0 EXIT D
.S RMPRNODE=$G(^RMPR(660,RMPRIEN,1)) Q:RMPRNODE=""
.S RMPRPNTR=$P(RMPRNODE,"^",5) Q:RMPRPNTR=""
.S RMPRREC=$G(^RMPR(661.2,RMPRPNTR,0)),RMPRDAT=$P(RMPRREC,"^",1) Q:RMPRDAT'>0
.I RMPRDAT<RMPRYR D
..;
..S DIK="^RMPR(661.2,",DA=RMPRPNTR D ^DIK
..;
..; DELETE RECORD IN RMPR(661.2
..;
..S DR="4.6///@",DIE="^RMPR(660,",DA=RMPRIEN D ^DIE
..;
..; REMOVE POINTER FROM RMPR(660,FIELD 4.6
..;
..Q
.Q
Q
BACKUP ;
; CREATE BACKUP OF GLOBAL ^RMPR(661.2 TO ^XTMP("RMPR6612"
; PURGE DATE WILL BE 90 DAYS FOR THE DATE THIS PATCH IS RUN
;
S DA=0
D NOW^%DTC S RMPRPGDT=X+0000300,RMPRTODT=X
S ^XTMP("RMPR6612",0)=RMPRPGDT_"^"_RMPRTODT
F S DA=$O(^RMPR(661.2,DA)) Q:'DA D
.S ^XTMP("RMPR6612",DA,0)=$G(^RMPR(661.2,DA,0))
.I $D(^RMPR(661.2,DA,1)) S ^XTMP("RMPR6612",DA,1)=$G(^RMPR(661.2,DA,1))
.Q
Q
EXIT ;
Q:+$G(DUZ)'>0
S RMPRDUZ=$$WHO^RMPREOU(DUZ)
S XMY(RMPRDUZ)=""
S XMDUZ=DUZ
S XMSUB="PATCH RMPR*3.0*107 HAS COMPLETED"
S RMPRMSG(1)="PATCH RMPR*3.0*107 HAS COMPLETED SUCCESSFULLY"
S XMTEXT="RMPRMSG("
D ^XMD
; End of Message
K RMPRIEN,RMPRNODE,RMPRPNTR,RMPRREC,RMPRDAT,RMPRYR,DIE,DIK,DA,DR
K RMPRDUZ,RMPRMSG,RMPRPGDT,RMPRTODT,RMPRORDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR61PG 2319 printed Apr 09, 2024@21:39:42 Page 2
RMPR61PG ;OIFO HINES/AA-PURGE 661.2 PROS STOCK ITEM RECORD FILE ;04/16/05
+1 ;;3.0;PROSTHETICS;**107**;04/16/05
+2 ;
+3 ; This routine used to remove records from Global RMPR(661.2
+4 ; and remove the pointers to RMPR(661.2 from Global
+5 ; RMPR(660 field 4.6 to reduce the install time for Patch RMPR*3*61
+6 ;
+7 ;
EN ;
+1 ; Check for installed RMPR*3.0*61 sites ** DO NOT CONTINUE PROCESS
+2 ; Patch 61 creates global #661.6
+3 ;
+4 IF '$DATA(^RMPR(661.6,0))
DO BACKUP
DO UPDATE
GOTO EXIT
QUIT
+5 QUIT
+6 ;
UPDATE ;
+1 ; Processing for non-installed RMPR*3.0*61 sites ** CONTINE TO PROCESS
+2 ;
+3 SET RMPRIEN=0
SET (RMPRDAT,RMPRORDT)=""
+4 DO NOW^%DTC
SET RMPRYR=X-0020000
SET RMPRDAT=X
+5 ;
+6 ; RMPRYR = used to determine entries 2 years or more prior to
+7 ; today's date
+8 ; RMPRIEN = Internal Entry Number for records in RMPR(660
+9 ; RMPRNODE = Store the one (1) node for the selected record
+10 ; RMPRPNTR = Pointer to record IEN in Global RMPR(661.2
+11 ; RMPRREC = Store the zero Node of the RMPR(661.2 Record
+12 ; RMPRDAT = Record Date used to identify records 2+ years from
+13 ; today's date.
+14 ;
+15 FOR
SET RMPRIEN=$ORDER(^RMPR(660,RMPRIEN))
if RMPRIEN'>0
GOTO EXIT
Begin DoDot:1
+16 SET RMPRNODE=$GET(^RMPR(660,RMPRIEN,1))
if RMPRNODE=""
QUIT
+17 SET RMPRPNTR=$PIECE(RMPRNODE,"^",5)
if RMPRPNTR=""
QUIT
+18 SET RMPRREC=$GET(^RMPR(661.2,RMPRPNTR,0))
SET RMPRDAT=$PIECE(RMPRREC,"^",1)
if RMPRDAT'>0
QUIT
+19 IF RMPRDAT<RMPRYR
Begin DoDot:2
+20 ;
+21 SET DIK="^RMPR(661.2,"
SET DA=RMPRPNTR
DO ^DIK
+22 ;
+23 ; DELETE RECORD IN RMPR(661.2
+24 ;
+25 SET DR="4.6///@"
SET DIE="^RMPR(660,"
SET DA=RMPRIEN
DO ^DIE
+26 ;
+27 ; REMOVE POINTER FROM RMPR(660,FIELD 4.6
+28 ;
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 QUIT
BACKUP ;
+1 ; CREATE BACKUP OF GLOBAL ^RMPR(661.2 TO ^XTMP("RMPR6612"
+2 ; PURGE DATE WILL BE 90 DAYS FOR THE DATE THIS PATCH IS RUN
+3 ;
+4 SET DA=0
+5 DO NOW^%DTC
SET RMPRPGDT=X+0000300
SET RMPRTODT=X
+6 SET ^XTMP("RMPR6612",0)=RMPRPGDT_"^"_RMPRTODT
+7 FOR
SET DA=$ORDER(^RMPR(661.2,DA))
if 'DA
QUIT
Begin DoDot:1
+8 SET ^XTMP("RMPR6612",DA,0)=$GET(^RMPR(661.2,DA,0))
+9 IF $DATA(^RMPR(661.2,DA,1))
SET ^XTMP("RMPR6612",DA,1)=$GET(^RMPR(661.2,DA,1))
+10 QUIT
End DoDot:1
+11 QUIT
EXIT ;
+1 if +$GET(DUZ)'>0
QUIT
+2 SET RMPRDUZ=$$WHO^RMPREOU(DUZ)
+3 SET XMY(RMPRDUZ)=""
+4 SET XMDUZ=DUZ
+5 SET XMSUB="PATCH RMPR*3.0*107 HAS COMPLETED"
+6 SET RMPRMSG(1)="PATCH RMPR*3.0*107 HAS COMPLETED SUCCESSFULLY"
+7 SET XMTEXT="RMPRMSG("
+8 DO ^XMD
+9 ; End of Message
+10 KILL RMPRIEN,RMPRNODE,RMPRPNTR,RMPRREC,RMPRDAT,RMPRYR,DIE,DIK,DA,DR
+11 KILL RMPRDUZ,RMPRMSG,RMPRPGDT,RMPRTODT,RMPRORDT
+12 QUIT
