DG53358M ;ALB/AEG - DG*5.3*358 POST INSTALL (CONT) ;3-5-2001
;;5.3;Registration;**358,1015**;3-5-2001;Build 21
;
MBDST ; Called after Phase II processing completes to send user a message
; as to the details of mt status inconsistencies.
I '$D(^TMP($J,"PAT")) D
.S ^UTILITY($J,1)="No inconsistencies were noted between the CURRENT MEANS TEST"
.S ^UTILITY($J,2)="STATUS field (#.14) of the PATIENT file (#2) and the STATUS"
.S ^UTILITY($J,3)="field (#.03) of the ANNUAL MEANS TEST file (#408.31)."
I $D(^TMP($J,"PAT")) D
.S ^UTILITY($J,1)="The following inconsistencies were found between the CURRENT MEANS"
.S ^UTILITY($J,2)="TEST STATUS field (#.14) of the PATIENT file (#2) and the"
.S ^UTILITY($J,3)="STATUS field (#.03) of the ANNUAL MEANS TEST file (#408.31)."
.S ^UTILITY($J,4)="The inconsistencies have been corrected."
.S ^UTILITY($J,5)=" "
.S ^UTILITY($J,6)=$$BLDSTR("PATIENT NAME","SSN","CATEGORY (PAT)","CATEGORY (MEANS)")
.S ^UTILITY($J,7)=$$BLDSTR("------------","---","--------------","----------------")
.N NM,IEN,I,DFN,DPTS,LST4,P1,P2,P3,P4,NM1
.S (NM,IEN)=""
.F I=8:1 S NM=$O(^TMP($J,"PAT",NM)) Q:NM="" S IEN="" F S IEN=$O(^TMP($J,"PAT",NM,IEN)) Q:IEN="" D
..S DFN=$P($G(^TMP($J,"PAT",NM,IEN)),U,1),DPTS=$P($G(^TMP($J,"PAT",NM,IEN)),U,2)
..S DPTS=$S(DPTS'="":$P($G(^DG(408.32,DPTS,0)),U,1),DPTS="":" ",1:" ")
..S DGMTS=$P($G(^TMP($J,"PAT",NM,IEN)),U,4),DGMTS=$S(DGMTS'="":$P($G(^DG(408.32,DGMTS,0)),U,1),DGMTS="":" ",1:" ")
..S NM1=$E($G(NM),1,15) I NM1["^" S NM1=$P($G(NM1),U,1)
..S LST4=$E($P($G(^DPT(DFN,0)),U,9),6,9)
..S P1=NM1,P2=LST4,P3=DPTS,P4=DGMTS
..S ^UTILITY($J,I)=$$BLDSTR(P1,P2,P3,P4)
..Q
.Q
N DIFROM,%
N XMDUZ,XMSUB,XMTEXT,XMY,Y
S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
S XMTEXT="^UTILITY($J,"
D NOW^%DTC S Y=% D DD^%DT
S XMSUB="DG*5.3*358 POST INSTALL - Phase II report "_Y
D ^XMD
D BMES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
K ^UTILITY($J),^TMP($J,"PAT")
Q
BADEN ; Process Phase III portion of cleanup report
K ^UTILITY($J)
I '$D(^TMP($J,"BADEN")) D
.S ^UTILITY($J,1)="No means test records found where the CURRENT MEANS TEST STATUS field (#.14)"
.S ^UTILITY($J,2)="of the PATIENT file (#2) was populated without a corresponding"
.S ^UTILITY($J,3)="Means Test on file."
I $D(^TMP($J,"BADEN")) D
.S ^UTILITY($J,1)="The following patients had the CURRENT MEANS TEST STATUS field (#.14)"
.S ^UTILITY($J,2)="of the PATIENT file (#2) populated; however, there was no"
.S ^UTILITY($J,3)="corresponding Means Test on File. The PATIENT file has been"
.S ^UTILITY($J,4)="updated."
.S ^UTILITY($J,5)=" "
.S ^UTILITY($J,6)=$$BLDSTR("PATIENT NAME","SSN","CURRENT MT STATUS","")
.S ^UTILITY($J,7)=$$BLDSTR("------------","---","-----------------","")
.N DGDFN,DPTSTAT,NM,NM1,LST4,DPTS,P1,P2,P3,P4
.S (DGDFN,DPTSTAT)=""
.F I=8:1 S DGDFN=$O(^TMP($J,"BADEN",DGDFN)) Q:'+DGDFN S DPTSTAT="" F S DPTSTAT=$O(^TMP($J,"BADEN",DGDFN,DPTSTAT)) Q:DPTSTAT="" D
..S NM=$P($G(^DPT(DGDFN,0)),U),NM1=$E($G(NM),1,15)
..S LST4=$E($P($G(^DPT(DGDFN,0)),U,9),6,9)
..S DPTS=$P($G(^DG(408.32,DPTSTAT,0)),U,1),DPTS=$E($G(DPTS),1,15)
..S P1=NM1,P2=LST4,P3=DPTS,P4=""
..S ^UTILITY($J,I)=$$BLDSTR(P1,P2,P3,P4)
..Q
.Q
N DIFROM,%,Y
N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
D NOW^%DTC S Y=% D DD^%DT
S XMSUB="DG*5.3*358 POST INSTALL - Phase III report "_Y
S XMTEXT="^UTILITY($J,"
D ^XMD
D BMES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
K ^TMP($J,"BADEN"),^UTILITY($J)
Q
DOAN ; Phase IV Process Reporting
;
; This reporting mechanism is broken down into 2 distinct parts.
;
; 1. An email will be generated on those patients that were in a NLR
; status and the date of the test was > than the date of death. The
; tests meeting those criteria were treated as invalid and purged.
;
; 2. An email will be generated for those test in an NLR status on
; expired patients where the date of the test was on or before the
; date of death. These test statii were recalculated to what they
; were prior to date of death.
;
; PART I
I '$D(^TMP($J,"NLR-DEL")) D
.S ^UTILITY($J,1)="No means test records were found in a status of 'NO LONGER REQUIRED'"
.S ^UTILITY($J,2)="where the date of the test is greater than the date of death."
I $D(^TMP($J,"NLR-DEL")) D
.S ^UTILITY($J,1)="The following means tests were found in a status of 'NO LONGER REQUIRED'"
.S ^UTILITY($J,2)="and the test date was entered after the date of death. These tests"
.S ^UTILITY($J,3)="are considered to be invalid and have been purged."
.S ^UTILITY($J,4)=" "
.S ^UTILITY($J,5)=$$BLDSTR("PATIENT NAME","SSN","DATE OF DEATH","DATE OF TEST")
.S ^UTILITY($J,6)=$$BLDSTR("------------","---","-------------","------------")
.N DGDFN,DGMTI,DGDOD,DGMTS,DOD,DOT,DOT1,DGDFN1
.S (DGDFN,DGMTI,DGDFN1)=""
.F I=8:1 S DGDFN1=$O(^TMP($J,"NLR-DEL",DGDFN1)) Q:'+DGDFN1 D
..S DGDFN=$P($G(DGDFN1),"~~",1),DGMTI=$P($G(DGDFN1),"~~",2)
..S NM=$P($G(^DPT(DGDFN,0)),U,1),NM1=$E($G(NM),1,15)
..S LST4=$E($P($G(^DPT(DGDFN,0)),U,9),6,9)
..S DOT=$P($G(^TMP($J,"NLR-DEL",DGDFN1)),U,1)
..S Y=DOT X ^DD("DD") S DOT1=Y
..S DOD=$P($G(^DPT(DGDFN,.35)),U),Y=$P($G(DOD),".",1)
..X ^DD("DD") S DGDOD=Y
..S P1=NM1,P2=LST4,P3=DGDOD,P4=DOT1
..S ^UTILITY($J,I)=$$BLDSTR(P1,P2,P3,P4)
..Q
.Q
N DIFROM,%,Y
N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
S XMTEXT="^UTILITY($J,"
N %,Y
D NOW^%DTC S Y=% D DD^%DT
S XMSUB="DG*5.3*358 POST INSTALL - PHASE IV (PART 1) "_Y
D ^XMD
D MES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
K ^UTILITY($J),^TMP($J,"NLR-DEL")
;
P2 ; PART 2
I '$D(^TMP($J,"RECALC")) D
.S ^UTILITY($J,1)="No means test records found where the status is 'NO LONGER REQUIRED'"
.S ^UTILITY($J,2)="and the test date is on or before the date of death."
I $D(^TMP($J,"RECALC")) D
.N OLDSTAT,NEWSTAT,DGDFN,NEWCAT,OLDCAT,PID,TDATE,TDATE1,DGDFN1
.S (OLDSTAT,NEWSTAT,DGDFN,DGDFN1)=""
.S ^UTILITY($J,1)="The following patients have expired and had a means test"
.S ^UTILITY($J,2)="on file in a status of 'NO LONGER REQUIRED'. The test"
.S ^UTILITY($J,3)="dates are on or prior to the date of death; therefore, the status"
.S ^UTILITY($J,4)="has been recalculated to reflect the status at the time of"
.S ^UTILITY($J,5)="death."
.S ^UTILITY($J,6)=" "
.S ^UTILITY($J,7)=$$BLDSTR("PATIENT SSN","TEST DATE","OLD STATUS","NEW STATUS")
.S ^UTILITY($J,8)=$$BLDSTR("----------","---------","----------","----------")
.F I=9:1 S DGDFN1=$O(^TMP($J,"RECALC",DGDFN1)) Q:'+DGDFN1 D
..S DGDFN=$P($G(DGDFN1),"~~",1),TDATE=$P($G(DGDFN1),"~~",2)
..S PID=$E($P($G(^DPT(DGDFN,0)),U,9),1,3)_"-"_$E($P($G(^DPT(DGDFN,0)),U,9),4,5)_"-"_$E($P($G(^DPT(DGDFN,0)),U,9),6,9)
..S Y=TDATE X ^DD("DD") S TDATE1=Y
..S OLDCAT=$P($G(^TMP($J,"RECALC",DGDFN1)),U,1)
..S NEWCAT=$P($G(^TMP($J,"RECALC",DGDFN1)),U,2)
..S P1=PID,P2=TDATE1,P3=OLDCAT,P4=NEWCAT
..S ^UTILITY($J,I)=$$BLDSTR(P1,P2,P3,P4)
..Q
.Q
N DIFROM,%,Y
N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
S XMTEXT="^UTILITY($J,"
D NOW^%DTC S Y=% D DD^%DT
S XMSUB="DG*5.3*358 POST INSTALL - Phase IV (Part II) "_Y
D ^XMD
D MES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
K ^UTILITY($J),^TMP($J,"RECALC")
Q
BLDSTR(P1,P2,P3,P4) ; Build a string from input
N S1,S2,S3,S4
S S1=$E(P1,1,15) I $L(S1)'>14 D
.S S1=S1_$J("",(15-$L(S1)))
S S2=P2
S S3=$E(P3,1,15) I $L(S3)'>14 D
.S S3=S3_$J("",(15-$L(S3)))
S S4=$E(P4,1,15) I $L(S4)'>14 D
.S S4=S4_$J("",(15-$L(S4)))
Q S1_$J("",5)_S2_$J("",5)_S3_$J("",5)_S4
DG53358M ;ALB/AEG - DG*5.3*358 POST INSTALL (CONT) ;3-5-2001
+1 ;;5.3;Registration;**358,1015**;3-5-2001;Build 21
+2 ;
MBDST ; Called after Phase II processing completes to send user a message
+1 ; as to the details of mt status inconsistencies.
+2 IF '$DATA(^TMP($JOB,"PAT"))
Begin DoDot:1
+3 SET ^UTILITY($JOB,1)="No inconsistencies were noted between the CURRENT MEANS TEST"
+4 SET ^UTILITY($JOB,2)="STATUS field (#.14) of the PATIENT file (#2) and the STATUS"
+5 SET ^UTILITY($JOB,3)="field (#.03) of the ANNUAL MEANS TEST file (#408.31)."
End DoDot:1
+6 IF $DATA(^TMP($JOB,"PAT"))
Begin DoDot:1
+7 SET ^UTILITY($JOB,1)="The following inconsistencies were found between the CURRENT MEANS"
+8 SET ^UTILITY($JOB,2)="TEST STATUS field (#.14) of the PATIENT file (#2) and the"
+9 SET ^UTILITY($JOB,3)="STATUS field (#.03) of the ANNUAL MEANS TEST file (#408.31)."
+10 SET ^UTILITY($JOB,4)="The inconsistencies have been corrected."
+11 SET ^UTILITY($JOB,5)=" "
+12 SET ^UTILITY($JOB,6)=$$BLDSTR("PATIENT NAME","SSN","CATEGORY (PAT)","CATEGORY (MEANS)")
+13 SET ^UTILITY($JOB,7)=$$BLDSTR("------------","---","--------------","----------------")
+14 NEW NM,IEN,I,DFN,DPTS,LST4,P1,P2,P3,P4,NM1
+15 SET (NM,IEN)=""
+16 FOR I=8:1
SET NM=$ORDER(^TMP($JOB,"PAT",NM))
IF NM=""
QUIT
SET IEN=""
FOR
SET IEN=$ORDER(^TMP($JOB,"PAT",NM,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+17 SET DFN=$PIECE($GET(^TMP($JOB,"PAT",NM,IEN)),U,1)
SET DPTS=$PIECE($GET(^TMP($JOB,"PAT",NM,IEN)),U,2)
+18 SET DPTS=$SELECT(DPTS'="":$PIECE($GET(^DG(408.32,DPTS,0)),U,1),DPTS="":" ",1:" ")
+19 SET DGMTS=$PIECE($GET(^TMP($JOB,"PAT",NM,IEN)),U,4)
SET DGMTS=$SELECT(DGMTS'="":$PIECE($GET(^DG(408.32,DGMTS,0)),U,1),DGMTS="":" ",1:" ")
+20 SET NM1=$EXTRACT($GET(NM),1,15)
IF NM1["^"
SET NM1=$PIECE($GET(NM1),U,1)
+21 SET LST4=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),6,9)
+22 SET P1=NM1
SET P2=LST4
SET P3=DPTS
SET P4=DGMTS
+23 SET ^UTILITY($JOB,I)=$$BLDSTR(P1,P2,P3,P4)
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 NEW DIFROM,%
+27 NEW XMDUZ,XMSUB,XMTEXT,XMY,Y
+28 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+29 SET XMTEXT="^UTILITY($J,"
+30 DO NOW^%DTC
SET Y=%
DO DD^%DT
+31 SET XMSUB="DG*5.3*358 POST INSTALL - Phase II report "_Y
+32 DO ^XMD
+33 DO BMES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
+34 KILL ^UTILITY($JOB),^TMP($JOB,"PAT")
+35 QUIT
BADEN ; Process Phase III portion of cleanup report
+1 KILL ^UTILITY($JOB)
+2 IF '$DATA(^TMP($JOB,"BADEN"))
Begin DoDot:1
+3 SET ^UTILITY($JOB,1)="No means test records found where the CURRENT MEANS TEST STATUS field (#.14)"
+4 SET ^UTILITY($JOB,2)="of the PATIENT file (#2) was populated without a corresponding"
+5 SET ^UTILITY($JOB,3)="Means Test on file."
End DoDot:1
+6 IF $DATA(^TMP($JOB,"BADEN"))
Begin DoDot:1
+7 SET ^UTILITY($JOB,1)="The following patients had the CURRENT MEANS TEST STATUS field (#.14)"
+8 SET ^UTILITY($JOB,2)="of the PATIENT file (#2) populated; however, there was no"
+9 SET ^UTILITY($JOB,3)="corresponding Means Test on File. The PATIENT file has been"
+10 SET ^UTILITY($JOB,4)="updated."
+11 SET ^UTILITY($JOB,5)=" "
+12 SET ^UTILITY($JOB,6)=$$BLDSTR("PATIENT NAME","SSN","CURRENT MT STATUS","")
+13 SET ^UTILITY($JOB,7)=$$BLDSTR("------------","---","-----------------","")
+14 NEW DGDFN,DPTSTAT,NM,NM1,LST4,DPTS,P1,P2,P3,P4
+15 SET (DGDFN,DPTSTAT)=""
+16 FOR I=8:1
SET DGDFN=$ORDER(^TMP($JOB,"BADEN",DGDFN))
IF '+DGDFN
QUIT
SET DPTSTAT=""
FOR
SET DPTSTAT=$ORDER(^TMP($JOB,"BADEN",DGDFN,DPTSTAT))
IF DPTSTAT=""
QUIT
Begin DoDot:2
+17 SET NM=$PIECE($GET(^DPT(DGDFN,0)),U)
SET NM1=$EXTRACT($GET(NM),1,15)
+18 SET LST4=$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),6,9)
+19 SET DPTS=$PIECE($GET(^DG(408.32,DPTSTAT,0)),U,1)
SET DPTS=$EXTRACT($GET(DPTS),1,15)
+20 SET P1=NM1
SET P2=LST4
SET P3=DPTS
SET P4=""
+21 SET ^UTILITY($JOB,I)=$$BLDSTR(P1,P2,P3,P4)
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 NEW DIFROM,%,Y
+25 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+26 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+27 DO NOW^%DTC
SET Y=%
DO DD^%DT
+28 SET XMSUB="DG*5.3*358 POST INSTALL - Phase III report "_Y
+29 SET XMTEXT="^UTILITY($J,"
+30 DO ^XMD
+31 DO BMES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
+32 KILL ^TMP($JOB,"BADEN"),^UTILITY($JOB)
+33 QUIT
DOAN ; Phase IV Process Reporting
+1 ;
+2 ; This reporting mechanism is broken down into 2 distinct parts.
+3 ;
+4 ; 1. An email will be generated on those patients that were in a NLR
+5 ; status and the date of the test was > than the date of death. The
+6 ; tests meeting those criteria were treated as invalid and purged.
+7 ;
+8 ; 2. An email will be generated for those test in an NLR status on
+9 ; expired patients where the date of the test was on or before the
+10 ; date of death. These test statii were recalculated to what they
+11 ; were prior to date of death.
+12 ;
+13 ; PART I
+14 IF '$DATA(^TMP($JOB,"NLR-DEL"))
Begin DoDot:1
+15 SET ^UTILITY($JOB,1)="No means test records were found in a status of 'NO LONGER REQUIRED'"
+16 SET ^UTILITY($JOB,2)="where the date of the test is greater than the date of death."
End DoDot:1
+17 IF $DATA(^TMP($JOB,"NLR-DEL"))
Begin DoDot:1
+18 SET ^UTILITY($JOB,1)="The following means tests were found in a status of 'NO LONGER REQUIRED'"
+19 SET ^UTILITY($JOB,2)="and the test date was entered after the date of death. These tests"
+20 SET ^UTILITY($JOB,3)="are considered to be invalid and have been purged."
+21 SET ^UTILITY($JOB,4)=" "
+22 SET ^UTILITY($JOB,5)=$$BLDSTR("PATIENT NAME","SSN","DATE OF DEATH","DATE OF TEST")
+23 SET ^UTILITY($JOB,6)=$$BLDSTR("------------","---","-------------","------------")
+24 NEW DGDFN,DGMTI,DGDOD,DGMTS,DOD,DOT,DOT1,DGDFN1
+25 SET (DGDFN,DGMTI,DGDFN1)=""
+26 FOR I=8:1
SET DGDFN1=$ORDER(^TMP($JOB,"NLR-DEL",DGDFN1))
IF '+DGDFN1
QUIT
Begin DoDot:2
+27 SET DGDFN=$PIECE($GET(DGDFN1),"~~",1)
SET DGMTI=$PIECE($GET(DGDFN1),"~~",2)
+28 SET NM=$PIECE($GET(^DPT(DGDFN,0)),U,1)
SET NM1=$EXTRACT($GET(NM),1,15)
+29 SET LST4=$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),6,9)
+30 SET DOT=$PIECE($GET(^TMP($JOB,"NLR-DEL",DGDFN1)),U,1)
+31 SET Y=DOT
XECUTE ^DD("DD")
SET DOT1=Y
+32 SET DOD=$PIECE($GET(^DPT(DGDFN,.35)),U)
SET Y=$PIECE($GET(DOD),".",1)
+33 XECUTE ^DD("DD")
SET DGDOD=Y
+34 SET P1=NM1
SET P2=LST4
SET P3=DGDOD
SET P4=DOT1
+35 SET ^UTILITY($JOB,I)=$$BLDSTR(P1,P2,P3,P4)
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
+38 NEW DIFROM,%,Y
+39 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+40 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+41 SET XMTEXT="^UTILITY($J,"
+42 NEW %,Y
+43 DO NOW^%DTC
SET Y=%
DO DD^%DT
+44 SET XMSUB="DG*5.3*358 POST INSTALL - PHASE IV (PART 1) "_Y
+45 DO ^XMD
+46 DO MES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
+47 KILL ^UTILITY($JOB),^TMP($JOB,"NLR-DEL")
+48 ;
P2 ; PART 2
+1 IF '$DATA(^TMP($JOB,"RECALC"))
Begin DoDot:1
+2 SET ^UTILITY($JOB,1)="No means test records found where the status is 'NO LONGER REQUIRED'"
+3 SET ^UTILITY($JOB,2)="and the test date is on or before the date of death."
End DoDot:1
+4 IF $DATA(^TMP($JOB,"RECALC"))
Begin DoDot:1
+5 NEW OLDSTAT,NEWSTAT,DGDFN,NEWCAT,OLDCAT,PID,TDATE,TDATE1,DGDFN1
+6 SET (OLDSTAT,NEWSTAT,DGDFN,DGDFN1)=""
+7 SET ^UTILITY($JOB,1)="The following patients have expired and had a means test"
+8 SET ^UTILITY($JOB,2)="on file in a status of 'NO LONGER REQUIRED'. The test"
+9 SET ^UTILITY($JOB,3)="dates are on or prior to the date of death; therefore, the status"
+10 SET ^UTILITY($JOB,4)="has been recalculated to reflect the status at the time of"
+11 SET ^UTILITY($JOB,5)="death."
+12 SET ^UTILITY($JOB,6)=" "
+13 SET ^UTILITY($JOB,7)=$$BLDSTR("PATIENT SSN","TEST DATE","OLD STATUS","NEW STATUS")
+14 SET ^UTILITY($JOB,8)=$$BLDSTR("----------","---------","----------","----------")
+15 FOR I=9:1
SET DGDFN1=$ORDER(^TMP($JOB,"RECALC",DGDFN1))
IF '+DGDFN1
QUIT
Begin DoDot:2
+16 SET DGDFN=$PIECE($GET(DGDFN1),"~~",1)
SET TDATE=$PIECE($GET(DGDFN1),"~~",2)
+17 SET PID=$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),1,3)_"-"_$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),4,5)_"-"_$EXTRACT($PIECE($GET(^DPT(DGDFN,0)),U,9),6,9)
+18 SET Y=TDATE
XECUTE ^DD("DD")
SET TDATE1=Y
+19 SET OLDCAT=$PIECE($GET(^TMP($JOB,"RECALC",DGDFN1)),U,1)
+20 SET NEWCAT=$PIECE($GET(^TMP($JOB,"RECALC",DGDFN1)),U,2)
+21 SET P1=PID
SET P2=TDATE1
SET P3=OLDCAT
SET P4=NEWCAT
+22 SET ^UTILITY($JOB,I)=$$BLDSTR(P1,P2,P3,P4)
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 NEW DIFROM,%,Y
+26 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+27 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+28 SET XMTEXT="^UTILITY($J,"
+29 DO NOW^%DTC
SET Y=%
DO DD^%DT
+30 SET XMSUB="DG*5.3*358 POST INSTALL - Phase IV (Part II) "_Y
+31 DO ^XMD
+32 DO MES^XPDUTL(" MAIL MESSAGE < #"_XMZ_" > sent.")
+33 KILL ^UTILITY($JOB),^TMP($JOB,"RECALC")
+34 QUIT
BLDSTR(P1,P2,P3,P4) ; Build a string from input
+1 NEW S1,S2,S3,S4
+2 SET S1=$EXTRACT(P1,1,15)
IF $LENGTH(S1)'>14
Begin DoDot:1
+3 SET S1=S1_$JUSTIFY("",(15-$LENGTH(S1)))
End DoDot:1
+4 SET S2=P2
+5 SET S3=$EXTRACT(P3,1,15)
IF $LENGTH(S3)'>14
Begin DoDot:1
+6 SET S3=S3_$JUSTIFY("",(15-$LENGTH(S3)))
End DoDot:1
+7 SET S4=$EXTRACT(P4,1,15)
IF $LENGTH(S4)'>14
Begin DoDot:1
+8 SET S4=S4_$JUSTIFY("",(15-$LENGTH(S4)))
End DoDot:1
+9 QUIT S1_$JUSTIFY("",5)_S2_$JUSTIFY("",5)_S3_$JUSTIFY("",5)_S4
