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

RG1P55.m

Go to the documentation of this file.
  1. RG1P55 ;ALB/MJB - POST-INSTALL RG*1*55 ; 11/7/08 2:53pm
  1. ;;1.0;CLINICAL INFO RESOURCE NETWORK;**55**;30 Apr 99;Build 11
  1. Q
  1. EN ;Entry Point
  1. D INIT ;Initialize Variables
  1. D REPORT ;Run Report
  1. Q
  1. INIT ;Setup XTMP variable
  1. K ^XTMP("RG1P55-"_$J)
  1. S ^XTMP("RG1P55-"_$J,0)=$$FMADD^XLFDT(""_DT_"",30)_U_DT_U_"Data for report for RG*1*55" ;Array used to store records that need to be reported.
  1. Q
  1. REPORT ;Report of data to be cleaned up.
  1. N RECNUM,RGDFN,RGPHN
  1. N DIFROM,XMSUB,XMTEXT,XMY,MSGTXT,LINENUM
  1. I '$D(^XTMP("RG1P55-"_$J,0)) D INIT ;If called directly
  1. S XMY(DUZ)="" ;Send message to installer
  1. S XMSUB="List of records with invalid phone numbers"
  1. S XMTEXT="MSGTXT("
  1. ;W "DFN",?15,"PHONE NUMBER",?30,!
  1. ;F I=1:1:53 W "-"
  1. ;W !
  1. S LINENUM=1
  1. S MSGTXT(LINENUM)="The records listed below have invalid phone numbers",LINENUM=LINENUM+1
  1. S MSGTXT(LINENUM)="",LINENUM=LINENUM+1,MSGTXT(LINENUM)="",LINENUM=LINENUM+1
  1. S MSGTXT(LINENUM)="DFN PHONE NUMBER ",LINENUM=LINENUM+1
  1. S MSGTXT(LINENUM)="----------------------------------------------------------",LINENUM=LINENUM+1
  1. S RECNUM=0 ;start after the file header
  1. F S RECNUM=$O(^DPT(RECNUM)) Q:RECNUM'>0 D
  1. .S RGDFN=RECNUM
  1. .S RGPHN=$G(^DPT(RECNUM,.13)) Q:RGPHN'["~PH" D
  1. ..S ^XTMP("RG1P55-"_$J,RECNUM)=RGPHN ;Store Bad Records
  1. ..;W PTDFN,?15,RECNUM,?30,FDATE,!
  1. ..S MSGTXT(LINENUM)=$E(RGDFN_" ",1,15)_RGPHN
  1. ..S LINENUM=LINENUM+1
  1. D ^XMD
  1. Q