Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCP98

GMRCP98.m

Go to the documentation of this file.
  1. GMRCP98 ;ALB/WTC - Database repair for scheduling events ;12/19/17 09:56
  1. ;;3.0;CONSULT/REQUEST TRACKING;**98**;;Build 8
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. ;
  1. REQACT ;
  1. ;
  1. ; Correct date/time stored as string in "B" cross-reference.
  1. ;
  1. N D0,D1,DATETIME,NEWDT,FIXED,I,TOTAL,PROGRESS,COMPLETE ;
  1. ;
  1. S (D0,FIXED)=0 ;
  1. S TOTAL=$P(^GMR(123,0),"^",4) ;
  1. F I=10:10:100 S COMPLETE(I)=0 ;
  1. ;
  1. ; Scan Consult file
  1. ;
  1. F I=1:1 S D0=$O(^GMR(123,D0)) Q:'D0 D ;
  1. . ;
  1. . ; Report progress to user
  1. . ;
  1. . I I#1000=0 W "." ;
  1. . S PROGRESS=I/TOTAL*100\1 I PROGRESS>0,PROGRESS#10=0,COMPLETE(PROGRESS)=0 W !,PROGRESS,"% complete." S COMPLETE(PROGRESS)=1 ;
  1. . ;
  1. . ; Start scan of date/time cross-reference at end of numeric entries
  1. . ;
  1. . S DATETIME=9999999.999999 ;
  1. . F S DATETIME=$O(^GMR(123,D0,40,"B",DATETIME)) Q:DATETIME="" D ;
  1. .. ;
  1. .. ; Scan activity multiple's date/time cross reference for string entries.
  1. .. ;
  1. .. S D1=0 F S D1=$O(^GMR(123,D0,40,"B",DATETIME,D1)) Q:'D1 D ;
  1. ... ;
  1. ... ; Strip off trailing zeroes so date/time is numeric
  1. ... ;
  1. ... S NEWDT=+DATETIME ;
  1. ... ;
  1. ... ; Update multiple and cross-reference. Delete string cross-reference entry.
  1. ... ;
  1. ... S $P(^GMR(123,D0,40,D1,0),"^",1)=NEWDT,^GMR(123,D0,40,"B",NEWDT,D1)=""
  1. ... K ^GMR(123,D0,40,"B",DATETIME,D1) ;
  1. ... S FIXED=FIXED+1 ;
  1. ... W !,FIXED,". ",DATETIME," ==> ",NEWDT ;
  1. ;
  1. Q ;
  1. ;