DG53P796 ;ALB/RC - POST-INSTALL DG*5.3*796 ; 11/7/08 2:53pm
;;5.3;Registration;**796**;Aug 13, 1993;Build 6
Q
EN ;Entry Point
D INIT ;Initialize Variables
D REPORT ;Run Report
D CLEANUP ;Run Cleanup
Q
INIT ;Setup XTMP variable
K ^XTMP("DG53P796-"_$J)
S ^XTMP("DG53P796-"_$J,0)=$$FMADD^XLFDT(""_DT_"",30)_U_DT_U_"Data for cleanup for DG*5.3*796" ;Array used to store records that need to be cleaned up.
Q
REPORT ;Report of data to be cleaned up.
N RECNUM,DDATE,FDATE,PTDFN
N DIFROM,XMSUB,XMTEXT,XMY,MSGTXT,LINENUM
I '$D(^XTMP("DG53P796-"_$J,0)) D INIT ;If called directly
S XMY(DUZ)="" ;Send message to installer
S XMSUB="List of records changed by DG*5.3*796"
S XMTEXT="MSGTXT("
;W "DFN",?15,"PTF NUMBER",?30,"DISCHARGE MOVEMENT DATE",!
;F I=1:1:53 W "-"
;W !
S LINENUM=1
S MSGTXT(LINENUM)="The records listed below were cleaned up by DG*5.3*796",LINENUM=LINENUM+1
S MSGTXT(LINENUM)="",LINENUM=LINENUM+1,MSGTXT(LINENUM)="",LINENUM=LINENUM+1
S MSGTXT(LINENUM)="DFN PTF NUMBER DISCHARGE MVT DATE (501 MVT)",LINENUM=LINENUM+1
S MSGTXT(LINENUM)="----------------------------------------------------------",LINENUM=LINENUM+1
S RECNUM=0 ;start after the file header
F S RECNUM=$O(^DGPT(RECNUM)) Q:RECNUM'>0 D
.S DDATE=$$GET1^DIQ(45,$$IENS^DILF(RECNUM),70) ;Discharge Date
.S FDATE=$$GET1^DIQ(45.02,"1,"_RECNUM,10) ;501 Discharge Date
.I DDATE'=FDATE,DDATE="" D
..S ^XTMP("DG53P796-"_$J,RECNUM)=FDATE ;Store Bad Records
..S PTDFN=$$GET1^DIQ(45,$$IENS^DILF(RECNUM),.01,"I")
..;W PTDFN,?15,RECNUM,?30,FDATE,!
..S MSGTXT(LINENUM)=$E(PTDFN_" ",1,15)_$E(RECNUM_" ",1,15)_FDATE
..S LINENUM=LINENUM+1
D ^XMD
Q
CLEANUP ;Perform clean up of records marked above.
N RECNUM,DGFDA,I,TXTLINE,ERRFND
N DIFROM,XMSUB,XMTEXT,XMY,MSGTXT,LINENUM
S XMSUB="Errors encountered during post-install of DG*5.3*796"
S XMY(DUZ)=""
S XMTEXT="MSGTXT("
S LINENUM=1
S MSGTXT(LINENUM)="The following errors were encountered while running the post-install routine in DG*5.3*796"
S MSGTXT(LINENUM)="",LINENUM=LINENUM+1,MSGTXT(LINENUM)="",LINENUM=LINENUM+1
I '$D(^XTMP("DG53P796-"_$J,0)) D REPORT ;If called directly
S RECNUM=0,DGFDA="",DGMSG="" ;Start at the first record.
F S RECNUM=$O(^XTMP("DG53P796-"_$J,RECNUM)) Q:'RECNUM D
.S DGFDA(45.02,"1,"_$$IENS^DILF(RECNUM),10)="@" D FILE^DIE("","DGFDA")
.I $D(DIERR) D ;if we encounter an error, record it.
..S ERRFND=1 ;we encountered an error
..S MSGTXT(LINENUM)="The following errors were encountered with PTF record "_RECNUM_".",LINENUM=LINENUM+1
..F I=1:1:DIERR D
...S MSGTXT(LINENUM)="Error Number: "_^TMP("DIERR",$J,I),LINENUM=LINENUM+1
...S TXTLINE=""
...F S TXTLINE=$O(^TMP("DIERR",$J,I,"TEXT",TXTLINE)) Q:'TXTLINE D
....S MSGTXT(LINENUM)=^TMP("DIERR",$J,I,"TEXT",TXTLINE),LINENUM=LINENUM+1
.K DGFDA ;Cleanup data
I $G(ERRFND) D ^XMD ;only send if an error occurred.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53P796 2957 printed Dec 13, 2024@02:40:08 Page 2
DG53P796 ;ALB/RC - POST-INSTALL DG*5.3*796 ; 11/7/08 2:53pm
+1 ;;5.3;Registration;**796**;Aug 13, 1993;Build 6
+2 QUIT
EN ;Entry Point
+1 ;Initialize Variables
DO INIT
+2 ;Run Report
DO REPORT
+3 ;Run Cleanup
DO CLEANUP
+4 QUIT
INIT ;Setup XTMP variable
+1 KILL ^XTMP("DG53P796-"_$JOB)
+2 ;Array used to store records that need to be cleaned up.
SET ^XTMP("DG53P796-"_$JOB,0)=$$FMADD^XLFDT(""_DT_"",30)_U_DT_U_"Data for cleanup for DG*5.3*796"
+3 QUIT
REPORT ;Report of data to be cleaned up.
+1 NEW RECNUM,DDATE,FDATE,PTDFN
+2 NEW DIFROM,XMSUB,XMTEXT,XMY,MSGTXT,LINENUM
+3 ;If called directly
IF '$DATA(^XTMP("DG53P796-"_$JOB,0))
DO INIT
+4 ;Send message to installer
SET XMY(DUZ)=""
+5 SET XMSUB="List of records changed by DG*5.3*796"
+6 SET XMTEXT="MSGTXT("
+7 ;W "DFN",?15,"PTF NUMBER",?30,"DISCHARGE MOVEMENT DATE",!
+8 ;F I=1:1:53 W "-"
+9 ;W !
+10 SET LINENUM=1
+11 SET MSGTXT(LINENUM)="The records listed below were cleaned up by DG*5.3*796"
SET LINENUM=LINENUM+1
+12 SET MSGTXT(LINENUM)=""
SET LINENUM=LINENUM+1
SET MSGTXT(LINENUM)=""
SET LINENUM=LINENUM+1
+13 SET MSGTXT(LINENUM)="DFN PTF NUMBER DISCHARGE MVT DATE (501 MVT)"
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(^DGPT(RECNUM))
if RECNUM'>0
QUIT
Begin DoDot:1
+17 ;Discharge Date
SET DDATE=$$GET1^DIQ(45,$$IENS^DILF(RECNUM),70)
+18 ;501 Discharge Date
SET FDATE=$$GET1^DIQ(45.02,"1,"_RECNUM,10)
+19 IF DDATE'=FDATE
IF DDATE=""
Begin DoDot:2
+20 ;Store Bad Records
SET ^XTMP("DG53P796-"_$JOB,RECNUM)=FDATE
+21 SET PTDFN=$$GET1^DIQ(45,$$IENS^DILF(RECNUM),.01,"I")
+22 ;W PTDFN,?15,RECNUM,?30,FDATE,!
+23 SET MSGTXT(LINENUM)=$EXTRACT(PTDFN_" ",1,15)_$EXTRACT(RECNUM_" ",1,15)_FDATE
+24 SET LINENUM=LINENUM+1
End DoDot:2
End DoDot:1
+25 DO ^XMD
+26 QUIT
CLEANUP ;Perform clean up of records marked above.
+1 NEW RECNUM,DGFDA,I,TXTLINE,ERRFND
+2 NEW DIFROM,XMSUB,XMTEXT,XMY,MSGTXT,LINENUM
+3 SET XMSUB="Errors encountered during post-install of DG*5.3*796"
+4 SET XMY(DUZ)=""
+5 SET XMTEXT="MSGTXT("
+6 SET LINENUM=1
+7 SET MSGTXT(LINENUM)="The following errors were encountered while running the post-install routine in DG*5.3*796"
+8 SET MSGTXT(LINENUM)=""
SET LINENUM=LINENUM+1
SET MSGTXT(LINENUM)=""
SET LINENUM=LINENUM+1
+9 ;If called directly
IF '$DATA(^XTMP("DG53P796-"_$JOB,0))
DO REPORT
+10 ;Start at the first record.
SET RECNUM=0
SET DGFDA=""
SET DGMSG=""
+11 FOR
SET RECNUM=$ORDER(^XTMP("DG53P796-"_$JOB,RECNUM))
if 'RECNUM
QUIT
Begin DoDot:1
+12 SET DGFDA(45.02,"1,"_$$IENS^DILF(RECNUM),10)="@"
DO FILE^DIE("","DGFDA")
+13 ;if we encounter an error, record it.
IF $DATA(DIERR)
Begin DoDot:2
+14 ;we encountered an error
SET ERRFND=1
+15 SET MSGTXT(LINENUM)="The following errors were encountered with PTF record "_RECNUM_"."
SET LINENUM=LINENUM+1
+16 FOR I=1:1:DIERR
Begin DoDot:3
+17 SET MSGTXT(LINENUM)="Error Number: "_^TMP("DIERR",$JOB,I)
SET LINENUM=LINENUM+1
+18 SET TXTLINE=""
+19 FOR
SET TXTLINE=$ORDER(^TMP("DIERR",$JOB,I,"TEXT",TXTLINE))
if 'TXTLINE
QUIT
Begin DoDot:4
+20 SET MSGTXT(LINENUM)=^TMP("DIERR",$JOB,I,"TEXT",TXTLINE)
SET LINENUM=LINENUM+1
End DoDot:4
End DoDot:3
End DoDot:2
+21 ;Cleanup data
KILL DGFDA
End DoDot:1
+22 ;only send if an error occurred.
IF $GET(ERRFND)
DO ^XMD
+23 QUIT
