GMRCP98 ;ALB/WTC - Database repair for scheduling events ;12/19/17 09:56
;;3.0;CONSULT/REQUEST TRACKING;**98**;;Build 8
;;Per VHA Directive 2004-038, this routine should not be modified
;
REQACT ;
;
; Correct date/time stored as string in "B" cross-reference.
;
N D0,D1,DATETIME,NEWDT,FIXED,I,TOTAL,PROGRESS,COMPLETE ;
;
S (D0,FIXED)=0 ;
S TOTAL=$P(^GMR(123,0),"^",4) ;
F I=10:10:100 S COMPLETE(I)=0 ;
;
; Scan Consult file
;
F I=1:1 S D0=$O(^GMR(123,D0)) Q:'D0 D ;
. ;
. ; Report progress to user
. ;
. I I#1000=0 W "." ;
. S PROGRESS=I/TOTAL*100\1 I PROGRESS>0,PROGRESS#10=0,COMPLETE(PROGRESS)=0 W !,PROGRESS,"% complete." S COMPLETE(PROGRESS)=1 ;
. ;
. ; Start scan of date/time cross-reference at end of numeric entries
. ;
. S DATETIME=9999999.999999 ;
. F S DATETIME=$O(^GMR(123,D0,40,"B",DATETIME)) Q:DATETIME="" D ;
.. ;
.. ; Scan activity multiple's date/time cross reference for string entries.
.. ;
.. S D1=0 F S D1=$O(^GMR(123,D0,40,"B",DATETIME,D1)) Q:'D1 D ;
... ;
... ; Strip off trailing zeroes so date/time is numeric
... ;
... S NEWDT=+DATETIME ;
... ;
... ; Update multiple and cross-reference. Delete string cross-reference entry.
... ;
... S $P(^GMR(123,D0,40,D1,0),"^",1)=NEWDT,^GMR(123,D0,40,"B",NEWDT,D1)=""
... K ^GMR(123,D0,40,"B",DATETIME,D1) ;
... S FIXED=FIXED+1 ;
... W !,FIXED,". ",DATETIME," ==> ",NEWDT ;
;
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCP98 1453 printed Sep 23, 2025@19:22:39 Page 2
GMRCP98 ;ALB/WTC - Database repair for scheduling events ;12/19/17 09:56
+1 ;;3.0;CONSULT/REQUEST TRACKING;**98**;;Build 8
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
REQACT ;
+1 ;
+2 ; Correct date/time stored as string in "B" cross-reference.
+3 ;
+4 ;
NEW D0,D1,DATETIME,NEWDT,FIXED,I,TOTAL,PROGRESS,COMPLETE
+5 ;
+6 ;
SET (D0,FIXED)=0
+7 ;
SET TOTAL=$PIECE(^GMR(123,0),"^",4)
+8 ;
FOR I=10:10:100
SET COMPLETE(I)=0
+9 ;
+10 ; Scan Consult file
+11 ;
+12 ;
FOR I=1:1
SET D0=$ORDER(^GMR(123,D0))
if 'D0
QUIT
Begin DoDot:1
+13 ;
+14 ; Report progress to user
+15 ;
+16 ;
IF I#1000=0
WRITE "."
+17 ;
SET PROGRESS=I/TOTAL*100\1
IF PROGRESS>0
IF PROGRESS#10=0
IF COMPLETE(PROGRESS)=0
WRITE !,PROGRESS,"% complete."
SET COMPLETE(PROGRESS)=1
+18 ;
+19 ; Start scan of date/time cross-reference at end of numeric entries
+20 ;
+21 ;
SET DATETIME=9999999.999999
+22 ;
FOR
SET DATETIME=$ORDER(^GMR(123,D0,40,"B",DATETIME))
if DATETIME=""
QUIT
Begin DoDot:2
+23 ;
+24 ; Scan activity multiple's date/time cross reference for string entries.
+25 ;
+26 ;
SET D1=0
FOR
SET D1=$ORDER(^GMR(123,D0,40,"B",DATETIME,D1))
if 'D1
QUIT
Begin DoDot:3
+27 ;
+28 ; Strip off trailing zeroes so date/time is numeric
+29 ;
+30 ;
SET NEWDT=+DATETIME
+31 ;
+32 ; Update multiple and cross-reference. Delete string cross-reference entry.
+33 ;
+34 SET $PIECE(^GMR(123,D0,40,D1,0),"^",1)=NEWDT
SET ^GMR(123,D0,40,"B",NEWDT,D1)=""
+35 ;
KILL ^GMR(123,D0,40,"B",DATETIME,D1)
+36 ;
SET FIXED=FIXED+1
+37 ;
WRITE !,FIXED,". ",DATETIME," ==> ",NEWDT
End DoDot:3
End DoDot:2
End DoDot:1
+38 ;
+39 ;
QUIT
+40 ;
