DG53358A ;ALB/AEG - DG*5.3*358 POST INSTALL (CONT) ;3-5-2001
;;5.3;Registration;**358,1015**;3-5-2001;Build 21
;
DOAN ; Process records that are in a 'NO LONGER REQUIRED' status and pt.
; has a date of death.
;
; If test date is > date of death - invalid test and will be purged.
; If test date is '> date of death - test status will be recalculated.
;
I '$D(^TMP($J,"DGDOA-N")) D Q
.D BMES^XPDUTL("PHASE IV - No records found for patients that have expired")
.D MES^XPDUTL("and have a Means Test status of 'NO LONGER REQUIRED'")
.D DOAN^DG53358M
.D MES^XPDUTL("PHASE IV completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
I $D(^TMP($J,"DGDOA-N")) D
.D BMES^XPDUTL("PHASE IV processing beginning at "_$$FMTE^XLFDT($$NOW^XLFDT))
.D BMES^XPDUTL("Processing Records where a date of death exists and the")
.D MES^XPDUTL("Means Test status is 'NO LONGER REQUIRED'")
.N MTIEN,DGDOA,DGDFN,DGMTD,DGDOA1,DGMTI,DFN,DGMSGF,OLDNODE,NEWNODE
.N DGMTYPT,ERRS,TDATE
.S (MTIEN,DGDOA,DGDFN,DGMTD,DGDOA1,DGMTI,DFN,DGMSGF,OLDNODE,NEWNODE)=""
.F S DGDFN=$O(^TMP($J,"DGDOA-N",DGDFN)) Q:DGDFN="" S MTIEN="" F S MTIEN=$O(^TMP($J,"DGDOA-N",DGDFN,MTIEN)) Q:MTIEN="" D
..S DGMTD=MTIEN
..S DGDOA="" F S DGDOA=$O(^TMP($J,"DGDOA-N",DGDFN,MTIEN,DGDOA)) Q:DGDOA="" D
...S DGDOA1=$P(DGDOA,".",1)
...; If date of test is greater than the date of death, test is not
...; valid and needs to be purged.
...D:DGMTD>DGDOA1
....S DGMTI=$P($G(^TMP($J,"DGDOA-N",DGDFN,MTIEN,DGDOA)),U,1)
....S DFN=DGDFN,DGMTYPT=1
....S ^TMP($J,"NLR-DEL",DFN_"~~"_DGMTI)=$G(^DGMT(408.31,DGMTI,0))
....I '$$EN^DG53358D(DGMTI) D
.....S ERRS(408.31,DGMTI,"ALL")="Unable to delete means test" Q
.....Q
....Q
...; If test date is not greater than date of death recalculate
...; status. If status is returned as required add to ^TMP global
...; for further processing.
...D:DGMTD'>DGDOA1
....S DGMSGF=1,DFN=DGDFN
....S DGMTI=$P($G(^TMP($J,"DGDOA-N",DGDFN,MTIEN,DGDOA)),U,1)
....S OLDNODE=$$LST^DGMTU(DGDFN,MTIEN,1)
....I $$AUTOCOMP^DGMTR(DGMTI)
....H .5
....S NEWNODE=$$LST^DGMTU(DGDFN,MTIEN,1)
....I $P(NEWNODE,U,4)'="R" S ^TMP($J,"RECALC",DFN_"~~"_$P($G(NEWNODE),U,2))=$P($G(OLDNODE),U,3)_U_$P($G(NEWNODE),U,3)
....I $P(NEWNODE,U,4)="R" S ^TMP($J,"DGDOA-R",DGDFN,MTIEN,DGDOA)=$G(NEWNODE)
...I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
...Q
..I $D(XPDNM) S %=$$UPCP^XPDUTL("MTIEN",MTIEN)
..Q
.I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDOA",DGDOA)
.Q
K ^TMP($J,"DGDOA-N")
D DOAN^DG53358M
D MES^XPDUTL("PHASE IV processing completed at "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
DOAR ; Process records that are in a 'REQUIRED' status and pt. has a
; date of death.
;
; If test date > date of death - invalid test and will be purged.
; If test date '> date of death - Report these as tests that need
; completion.
;
I '$D(^TMP($J,"DGDOA-R")) D Q
.D BMES^XPDUTL("PHASE V - No records found for patients that have expired")
.D MES^XPDUTL("and have a Means Test status of 'REQUIRED'")
.D DOAR^DG53358N
.D BMES^XPDUTL("PHASE V completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
I $D(^TMP($J,"DGDOA-R")) D
.D BMES^XPDUTL("PHASE V processing beginning at "_$$FMTE^XLFDT($$NOW^XLFDT))
.D BMES^XPDUTL("Processing records where a date of death exists and the")
.D MES^XPDUTL("Means Test status is 'REQUIRED'")
.N MTIEN,DGDOA,DGDFN,DGMTD,DGDOA1,DGMTI,DFN,DGMTYPT
.S (MTIEN,DGDOA,DGDFN,DGMTD,DGDOA1,DGMTI,DFN,DGMTYPT)=""
.F S DGDFN=$O(^TMP($J,"DGDOA-R",DGDFN)) Q:DGDFN="" S MTIEN="" F S MTIEN=$O(^TMP($J,"DGDOA-R",DGDFN,MTIEN)) Q:MTIEN="" D
..S DGMTD=MTIEN
..S DGDOA="" F S DGDOA=$O(^TMP($J,"DGDOA-R",DGDFN,MTIEN,DGDOA)) Q:DGDOA="" D
...S DGDOA1=$P(DGDOA,".",1)
...; If the date of the test is > the date of death, test is not
...; considered valid and will be purged.
...D:DGMTD>DGDOA1
....S DGMTI=$P($G(^TMP($J,"DGDOA-R",DGDFN,MTIEN,DGDOA)),U,1)
....S DFN=DGDFN,DGMTYPT=1
....S ^TMP($J,"REQ",DFN_"~~"_DGMTI)=$G(^DGMT(408.31,DGMTI,0))
....I '$$EN^DG53358D(DGMTI) D
.....S ERRS(408.31,DGMTI,"ALL")="Unable to delete means test" Q
.....Q
....Q
...; If the test date is not greater than the date of death, store
...; those records in a different node to report these test to user
...; running the tasks.
...D:(DGMTD'>DGDOA1)&(DGMTD'<$$INCY(DT))
....S DGMTI=$P($G(^TMP($J,"DGDOA-R",DGDFN,MTIEN,DGDOA)),U,1)
....S DFN=DGDFN
....S ^TMP($J,"REQ-COMP",DFN_"~~"_DGMTI)=$G(^DGMT(408.31,DGMTI,0))
....I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
....Q
...I $D(XPDNM) S %=$$UPCP^XPDUTL("MTIEN",MTIEN)
...Q
..I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDOA",DGDOA)
..Q
.Q
D DOAR^DG53358N
K ^TMP($J,"DGDOA-R")
D MES^XPDUTL("PHASE V processing completed at "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
INCY(DT) ; Determine previous income year
N X,%DT,Y,DGINY
S X="T",%DT="" D ^%DT
S DGINY=Y,DGINY=$$LYR^DGMTSCU1(DGINY)
Q (DGINY-10000)
DG53358A ;ALB/AEG - DG*5.3*358 POST INSTALL (CONT) ;3-5-2001
+1 ;;5.3;Registration;**358,1015**;3-5-2001;Build 21
+2 ;
DOAN ; Process records that are in a 'NO LONGER REQUIRED' status and pt.
+1 ; has a date of death.
+2 ;
+3 ; If test date is > date of death - invalid test and will be purged.
+4 ; If test date is '> date of death - test status will be recalculated.
+5 ;
+6 IF '$DATA(^TMP($JOB,"DGDOA-N"))
Begin DoDot:1
+7 DO BMES^XPDUTL("PHASE IV - No records found for patients that have expired")
+8 DO MES^XPDUTL("and have a Means Test status of 'NO LONGER REQUIRED'")
+9 DO DOAN^DG53358M
+10 DO MES^XPDUTL("PHASE IV completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
End DoDot:1
QUIT
+11 IF $DATA(^TMP($JOB,"DGDOA-N"))
Begin DoDot:1
+12 DO BMES^XPDUTL("PHASE IV processing beginning at "_$$FMTE^XLFDT($$NOW^XLFDT))
+13 DO BMES^XPDUTL("Processing Records where a date of death exists and the")
+14 DO MES^XPDUTL("Means Test status is 'NO LONGER REQUIRED'")
+15 NEW MTIEN,DGDOA,DGDFN,DGMTD,DGDOA1,DGMTI,DFN,DGMSGF,OLDNODE,NEWNODE
+16 NEW DGMTYPT,ERRS,TDATE
+17 SET (MTIEN,DGDOA,DGDFN,DGMTD,DGDOA1,DGMTI,DFN,DGMSGF,OLDNODE,NEWNODE)=""
+18 FOR
SET DGDFN=$ORDER(^TMP($JOB,"DGDOA-N",DGDFN))
IF DGDFN=""
QUIT
SET MTIEN=""
FOR
SET MTIEN=$ORDER(^TMP($JOB,"DGDOA-N",DGDFN,MTIEN))
IF MTIEN=""
QUIT
Begin DoDot:2
+19 SET DGMTD=MTIEN
+20 SET DGDOA=""
FOR
SET DGDOA=$ORDER(^TMP($JOB,"DGDOA-N",DGDFN,MTIEN,DGDOA))
IF DGDOA=""
QUIT
Begin DoDot:3
+21 SET DGDOA1=$PIECE(DGDOA,".",1)
+22 ; If date of test is greater than the date of death, test is not
+23 ; valid and needs to be purged.
+24 IF DGMTD>DGDOA1
Begin DoDot:4
+25 SET DGMTI=$PIECE($GET(^TMP($JOB,"DGDOA-N",DGDFN,MTIEN,DGDOA)),U,1)
+26 SET DFN=DGDFN
SET DGMTYPT=1
+27 SET ^TMP($JOB,"NLR-DEL",DFN_"~~"_DGMTI)=$GET(^DGMT(408.31,DGMTI,0))
+28 IF '$$EN^DG53358D(DGMTI)
Begin DoDot:5
+29 SET ERRS(408.31,DGMTI,"ALL")="Unable to delete means test"
QUIT
+30 QUIT
End DoDot:5
+31 QUIT
End DoDot:4
+32 ; If test date is not greater than date of death recalculate
+33 ; status. If status is returned as required add to ^TMP global
+34 ; for further processing.
+35 IF DGMTD'>DGDOA1
Begin DoDot:4
+36 SET DGMSGF=1
SET DFN=DGDFN
+37 SET DGMTI=$PIECE($GET(^TMP($JOB,"DGDOA-N",DGDFN,MTIEN,DGDOA)),U,1)
+38 SET OLDNODE=$$LST^DGMTU(DGDFN,MTIEN,1)
+39 IF $$AUTOCOMP^DGMTR(DGMTI)
+40 HANG .5
+41 SET NEWNODE=$$LST^DGMTU(DGDFN,MTIEN,1)
+42 IF $PIECE(NEWNODE,U,4)'="R"
SET ^TMP($JOB,"RECALC",DFN_"~~"_$PIECE($GET(NEWNODE),U,2))=$PIECE($GET(OLDNODE),U,3)_U_$PIECE($GET(NEWNODE),U,3)
+43 IF $PIECE(NEWNODE,U,4)="R"
SET ^TMP($JOB,"DGDOA-R",DGDFN,MTIEN,DGDOA)=$GET(NEWNODE)
End DoDot:4
+44 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
+45 QUIT
End DoDot:3
+46 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("MTIEN",MTIEN)
+47 QUIT
End DoDot:2
+48 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDOA",DGDOA)
+49 QUIT
End DoDot:1
+50 KILL ^TMP($JOB,"DGDOA-N")
+51 DO DOAN^DG53358M
+52 DO MES^XPDUTL("PHASE IV processing completed at "_$$FMTE^XLFDT($$NOW^XLFDT))
+53 QUIT
DOAR ; Process records that are in a 'REQUIRED' status and pt. has a
+1 ; date of death.
+2 ;
+3 ; If test date > date of death - invalid test and will be purged.
+4 ; If test date '> date of death - Report these as tests that need
+5 ; completion.
+6 ;
+7 IF '$DATA(^TMP($JOB,"DGDOA-R"))
Begin DoDot:1
+8 DO BMES^XPDUTL("PHASE V - No records found for patients that have expired")
+9 DO MES^XPDUTL("and have a Means Test status of 'REQUIRED'")
+10 DO DOAR^DG53358N
+11 DO BMES^XPDUTL("PHASE V completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
End DoDot:1
QUIT
+12 IF $DATA(^TMP($JOB,"DGDOA-R"))
Begin DoDot:1
+13 DO BMES^XPDUTL("PHASE V processing beginning at "_$$FMTE^XLFDT($$NOW^XLFDT))
+14 DO BMES^XPDUTL("Processing records where a date of death exists and the")
+15 DO MES^XPDUTL("Means Test status is 'REQUIRED'")
+16 NEW MTIEN,DGDOA,DGDFN,DGMTD,DGDOA1,DGMTI,DFN,DGMTYPT
+17 SET (MTIEN,DGDOA,DGDFN,DGMTD,DGDOA1,DGMTI,DFN,DGMTYPT)=""
+18 FOR
SET DGDFN=$ORDER(^TMP($JOB,"DGDOA-R",DGDFN))
IF DGDFN=""
QUIT
SET MTIEN=""
FOR
SET MTIEN=$ORDER(^TMP($JOB,"DGDOA-R",DGDFN,MTIEN))
IF MTIEN=""
QUIT
Begin DoDot:2
+19 SET DGMTD=MTIEN
+20 SET DGDOA=""
FOR
SET DGDOA=$ORDER(^TMP($JOB,"DGDOA-R",DGDFN,MTIEN,DGDOA))
IF DGDOA=""
QUIT
Begin DoDot:3
+21 SET DGDOA1=$PIECE(DGDOA,".",1)
+22 ; If the date of the test is > the date of death, test is not
+23 ; considered valid and will be purged.
+24 IF DGMTD>DGDOA1
Begin DoDot:4
+25 SET DGMTI=$PIECE($GET(^TMP($JOB,"DGDOA-R",DGDFN,MTIEN,DGDOA)),U,1)
+26 SET DFN=DGDFN
SET DGMTYPT=1
+27 SET ^TMP($JOB,"REQ",DFN_"~~"_DGMTI)=$GET(^DGMT(408.31,DGMTI,0))
+28 IF '$$EN^DG53358D(DGMTI)
Begin DoDot:5
+29 SET ERRS(408.31,DGMTI,"ALL")="Unable to delete means test"
QUIT
+30 QUIT
End DoDot:5
+31 QUIT
End DoDot:4
+32 ; If the test date is not greater than the date of death, store
+33 ; those records in a different node to report these test to user
+34 ; running the tasks.
+35 IF (DGMTD'>DGDOA1)&(DGMTD'<$$INCY(DT))
Begin DoDot:4
+36 SET DGMTI=$PIECE($GET(^TMP($JOB,"DGDOA-R",DGDFN,MTIEN,DGDOA)),U,1)
+37 SET DFN=DGDFN
+38 SET ^TMP($JOB,"REQ-COMP",DFN_"~~"_DGMTI)=$GET(^DGMT(408.31,DGMTI,0))
+39 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
+40 QUIT
End DoDot:4
+41 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("MTIEN",MTIEN)
+42 QUIT
End DoDot:3
+43 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDOA",DGDOA)
+44 QUIT
End DoDot:2
+45 QUIT
End DoDot:1
+46 DO DOAR^DG53358N
+47 KILL ^TMP($JOB,"DGDOA-R")
+48 DO MES^XPDUTL("PHASE V processing completed at "_$$FMTE^XLFDT($$NOW^XLFDT))
+49 QUIT
INCY(DT) ; Determine previous income year
+1 NEW X,%DT,Y,DGINY
+2 SET X="T"
SET %DT=""
DO ^%DT
+3 SET DGINY=Y
SET DGINY=$$LYR^DGMTSCU1(DGINY)
+4 QUIT (DGINY-10000)
