RG1P55 ;ALB/MJB - POST-INSTALL RG*1*55 ; 11/7/08 2:53pm
;;1.0;CLINICAL INFO RESOURCE NETWORK;**55**;30 Apr 99;Build 11
Q
EN ;Entry Point
D INIT ;Initialize Variables
D REPORT ;Run Report
Q
INIT ;Setup XTMP variable
K ^XTMP("RG1P55-"_$J)
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.
Q
REPORT ;Report of data to be cleaned up.
N RECNUM,RGDFN,RGPHN
N DIFROM,XMSUB,XMTEXT,XMY,MSGTXT,LINENUM
I '$D(^XTMP("RG1P55-"_$J,0)) D INIT ;If called directly
S XMY(DUZ)="" ;Send message to installer
S XMSUB="List of records with invalid phone numbers"
S XMTEXT="MSGTXT("
;W "DFN",?15,"PHONE NUMBER",?30,!
;F I=1:1:53 W "-"
;W !
S LINENUM=1
S MSGTXT(LINENUM)="The records listed below have invalid phone numbers",LINENUM=LINENUM+1
S MSGTXT(LINENUM)="",LINENUM=LINENUM+1,MSGTXT(LINENUM)="",LINENUM=LINENUM+1
S MSGTXT(LINENUM)="DFN PHONE NUMBER ",LINENUM=LINENUM+1
S MSGTXT(LINENUM)="----------------------------------------------------------",LINENUM=LINENUM+1
S RECNUM=0 ;start after the file header
F S RECNUM=$O(^DPT(RECNUM)) Q:RECNUM'>0 D
.S RGDFN=RECNUM
.S RGPHN=$G(^DPT(RECNUM,.13)) Q:RGPHN'["~PH" D
..S ^XTMP("RG1P55-"_$J,RECNUM)=RGPHN ;Store Bad Records
..;W PTDFN,?15,RECNUM,?30,FDATE,!
..S MSGTXT(LINENUM)=$E(RGDFN_" ",1,15)_RGPHN
..S LINENUM=LINENUM+1
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRG1P55 1479 printed Dec 13, 2024@01:41:16 Page 2
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
+2 QUIT
EN ;Entry Point
+1 ;Initialize Variables
DO INIT
+2 ;Run Report
DO REPORT
+3 QUIT
INIT ;Setup XTMP variable
+1 KILL ^XTMP("RG1P55-"_$JOB)
+2 ;Array used to store records that need to be reported.
SET ^XTMP("RG1P55-"_$JOB,0)=$$FMADD^XLFDT(""_DT_"",30)_U_DT_U_"Data for report for RG*1*55"
+3 QUIT
REPORT ;Report of data to be cleaned up.
+1 NEW RECNUM,RGDFN,RGPHN
+2 NEW DIFROM,XMSUB,XMTEXT,XMY,MSGTXT,LINENUM
+3 ;If called directly
IF '$DATA(^XTMP("RG1P55-"_$JOB,0))
DO INIT
+4 ;Send message to installer
SET XMY(DUZ)=""
+5 SET XMSUB="List of records with invalid phone numbers"
+6 SET XMTEXT="MSGTXT("
+7 ;W "DFN",?15,"PHONE NUMBER",?30,!
+8 ;F I=1:1:53 W "-"
+9 ;W !
+10 SET LINENUM=1
+11 SET MSGTXT(LINENUM)="The records listed below have invalid phone numbers"
SET LINENUM=LINENUM+1
+12 SET MSGTXT(LINENUM)=""
SET LINENUM=LINENUM+1
SET MSGTXT(LINENUM)=""
SET LINENUM=LINENUM+1
+13 SET MSGTXT(LINENUM)="DFN PHONE NUMBER "
SET LINENUM=LINENUM+1
+14 SET MSGTXT(LINENUM)="----------------------------------------------------------"
SET LINENUM=LINENUM+1
+15 ;start after the file header
SET RECNUM=0
+16 FOR
SET RECNUM=$ORDER(^DPT(RECNUM))
if RECNUM'>0
QUIT
Begin DoDot:1
+17 SET RGDFN=RECNUM
+18 SET RGPHN=$GET(^DPT(RECNUM,.13))
if RGPHN'["~PH"
QUIT
Begin DoDot:2
+19 ;Store Bad Records
SET ^XTMP("RG1P55-"_$JOB,RECNUM)=RGPHN
+20 ;W PTDFN,?15,RECNUM,?30,FDATE,!
+21 SET MSGTXT(LINENUM)=$EXTRACT(RGDFN_" ",1,15)_RGPHN
+22 SET LINENUM=LINENUM+1
End DoDot:2
End DoDot:1
+23 DO ^XMD
+24 QUIT
