- 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 Feb 18, 2025@23:12:59 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 ;