- 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 Jan 18, 2025@02:42:30 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