DG53358 ;ALB/AEG - DG*5.3*358 POST INSTALL TO MAIL MSG ;3-5-2001
;;5.3;Registration;**358,1015**;3-5-2001;Build 21
;
; This routine is a post-installation for patch DG*5.3*358
;
; This routine will perform a number of database clean-up
; functions. The primary functionality will cleanup
; inconsistent data between the CURRENT MEANS TEST STATUS
; field (#.14) of the PATIENT file (#2) and the STATUS
; field (#.03) of the ANNUAL MEANS TEST file (#408.31). In
; all instances, data in file #408.31 is considered correct
; as the Patient file is populated via a trigger on .03 field
; of file 408.31.
;
; The second issue being cleaned up deals with those patients
; that have expired and a Means test in the status of No Longer
; Required or Required. In both instances it is possible to
; to have a test on file dated after the patient has expired.
; In this instance, these tests are not valid and will be
; purged. In the instance where the test date is on or before
; the date of death the NLR status tests' status will be
; recalculated and set to it's previous value. In the case of
; REQUIRED status and date of test is on or before DOD these
; will be reported to need completion to the user running this
; task.
;
EN ; Main entry point for post-installation.
D INIT
Q
INIT ; Initialize tracking global and associated checkpoints.
K ^TMP($J),^XTMP("DG-BADEN"),^XTMP("DG-BADST"),^XTMP("DG-DGDOA")
N %,I,X,X1,X2
; Create Checkpoints
I $D(XPDNM) D
.I $$VERCP^XPDUTL("DGDFN")'>0 D
..S %=$$NEWCP^XPDUTL("DGDFN","",0)
.I $$VERCP^XPDUTL("MTIEN")'>0 D
..S %=$$NEWCP^XPDUTL("MTIEN","",0)
.I $$VERCP^XPDUTL("DGDOA")'>0 D
..S %=$$NEWCP^XPDUTL("DGDOA","",0)
;
; initialize tracking global(s)
F I="BADEN","BADST","DGDOA" D
.I $D(^XTMP("DG-"_I)) Q
.S X1=DT,X2=30 D C^%DTC
.S ^XTMP("DG-"_I,0)=X_U_$$DT^XLFDT_"^DG*5.3*358 POST INSTALL "
.S ^XTMP("DG_"_I,0)=^XTMP("DG-"_I,0)_$S(I="BADEN":"No means test on file",I="BADST":"Records corrected",1:"errors")
I '$D(XPDNM) S (^XTMP("DG-BADEN",1),^XTMP("DG-BADST",1),^XTMP("DG-DGDOA",1))=0
; check status and if root checkpoint has not completed start clean up
I $D(XPDNM) S %=$$VERCP^XPDUTL("DGDFN") D
.I '$D(^XTMP("DG-BADEN",1)) S ^XTMP("DG-BADEN",1)=0
.I '$D(^XTMP("DG-BADST",1)) S ^XTMP("DG-BADST",1)=0
.I '$D(^XTMP("DG-DGDOA",1)) S ^XTMP("DG-DGDOA",1)=0
I $G(%)="" S %=0
I %=0 D EN1
Q
EN1 ; Control logic flow and implement cleanup in phases
D LOOP,PAT,BADEN
D DOAN^DG53358A
D DOAR^DG53358A
I $D(XPDNM) D
.S %=$$COMCP^XPDUTL("DGDFN")
.S %=$$COMCP^XPDUTL("MTIEN")
.S %=$$COMCP^XPDUTL("DGDOA")
Q
LOOP ; Start loop in patient file to search for records with status
; inconsistency problems as well as DOD issues.
;
D BMES^XPDUTL("POST INSTALLATION PROCESSING")
D MES^XPDUTL("------------------------------")
D MES^XPDUTL("Once the post installation has completed, six mail messages")
D MES^XPDUTL("will be generated to report the number of inconsistencies")
D MES^XPDUTL("corrected as well as the Means Tests requiring completion.")
D BMES^XPDUTL("PHASE I - Search engine started at "_$$FMTE^XLFDT($$NOW^XLFDT))
D BMES^XPDUTL("Each "_"'.'"_" represents approximately 200 records ")
N DGDFN,MTIEN,DGMTDT,DGCNT,DGDOA
S (DGDFN,MTIEN,DGMTDT)=""
S DGDFN=0 F DGCNT=1:1 S DGDFN=$O(^DPT(DGDFN)) Q:'+DGDFN D
.I '$D(ZTQUEUED) W:'(DGCNT#200) "."
.; If patient does NOT have a date of death process
.D
..N DPTSTAT,DGMTSTAT,DGMTDT
..; If a MT is on file, check the status field (.03) against the
..; current MT status field (.14) in patient file. They should match.
..S MTIEN=$$LST^DGMTU(DGDFN,"",1)
..I +$G(MTIEN) D
...S DPTSTAT=$P($G(^DPT(DGDFN,0)),U,14),DGMTSTAT=$P($G(^DGMT(408.31,+MTIEN,0)),U,3)
...D:DPTSTAT'=DGMTSTAT
....S ^TMP($J,"BADST",DGDFN,+MTIEN)=DPTSTAT_U_DGMTSTAT
....; increment the counter for this inconsistency type
....S ^XTMP("DG-BADST",1)=$G(^XTMP("DG-BADST",1))+1
....Q
...Q
..; update checkpoint
..I $D(XPDNM) S %=$$UPCP^XPDUTL("MTIEN",+MTIEN)
..; If no means test is on file but the current means test status field
..; is populated, there is a consistency problem. Store this info. to
..; to be used for later cleanup.
..I '+$G(MTIEN) D
...S DPTSTAT=$P($G(^DPT(DGDFN,0)),U,14)
...I +DPTSTAT D
....S ^TMP($J,"BADEN",DGDFN,DPTSTAT)=""
....; Increment Counter
....S ^XTMP("DG-BADEN",1)=$G(^XTMP("DG-BADEN",1))+1
....Q
...Q
..Q
.I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
.; Process if a date of death exists.
.N DGDT,DGIDT,DGMTI,DGMTST,DGNODE
.D:$P($G(^DPT(DGDFN,.35)),U)'=""
..S DGDOA=$P($G(^DPT(DGDFN,.35)),U)
..S DGDT="",DGIDT=$S($G(DGDT)>0:-DGDT,1:-DT) S:'$P(DGIDT,".",2) DGIDT=DGIDT_.2359
..F S DGIDT=+$O(^DGMT(408.31,"AID",1,DGDFN,DGIDT)) Q:'DGIDT D
...F DGMTI=0:0 S DGMTI=$O(^DGMT(408.31,"AID",1,DGDFN,DGIDT,DGMTI)) Q:'DGMTI D
....S DGNODE=$G(^DGMT(408.31,DGMTI,0)),DGMTST=$P(DGNODE,U,3)
....Q:$P($G(DGNODE),U,19)'=1
....I DGNODE,$G(^("PRIM")) S MTIEN=DGMTI_"^"_$P(DGNODE,U)_"^"_$$MTS^DGMTU(DGDFN,DGMTST)_"^"_$P(DGNODE,U,23)
....; Process NO LONGER REQUIRED status expired patients
....I $G(MTIEN),$P(MTIEN,U,4)="N" D
.....S ^TMP($J,"DGDOA-N",DGDFN,$P(MTIEN,U,2),DGDOA)=$G(MTIEN)
.....; Increment NLR counter
.....S ^XTMP("DG-DGDOA",1)=$G(^XTMP("DG-DGDOA",1))+1
.....I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDOA",DGDOA)
....; Process REQUIRED status expired patients.
....I $G(MTIEN),$P(MTIEN,U,4)="R" D
.....S ^TMP($J,"DGDOA-R",DGDFN,$P(MTIEN,U,2),DGDOA)=$G(MTIEN)
.....S ^XTMP("DG-DGDOA",1)=$G(^XTMP("DG-DGDOA",1))+1
.....I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDOA",DGDOA)
....I $D(XPDNM) S %=$$UPCP^XPDUTL("MTIEN",+MTIEN)
.I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
D BMES^XPDUTL("Total Records reviewed - "_(DGCNT-1))
D MES^XPDUTL("PHASE I search of the patient file completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
PAT ; Use data we stored in ^TMP($J,"BADST" node and clean up the data
I '$D(^TMP($J,"BADST")) D Q
.D BMES^XPDUTL("PHASE II of processing has no inconsistent data to correct")
.D MBDST^DG53358M
.D MES^XPDUTL("PHASE II processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
I $D(^TMP($J,"BADST")) D
.D BMES^XPDUTL("PHASE II of the cleanup processing started on "_$$FMTE^XLFDT($$NOW^XLFDT))
.D BMES^XPDUTL("This phase of the process will cleanup those entries in the patient file")
.D MES^XPDUTL("that have inconsistent status entries in the CURRENT MEANS")
.D MES^XPDUTL("TEST STATUS field (#.14) of the PATIENT file (#2) ")
.N DGDFN,MTIEN,DGCNT,DGMTSTAT
.S (DGDFN,MTIEN)=""
.F DGCNT=1:1 S DGDFN=$O(^TMP($J,"BADST",DGDFN)) Q:'+DGDFN S MTIEN="" F S MTIEN=$O(^TMP($J,"BADST",DGDFN,MTIEN)) Q:MTIEN="" D
..I '$D(ZTQUEUED) W:'(DGCNT#100) "."
..S DPTSTAT=$P($G(^TMP($J,"BADST",DGDFN,MTIEN)),U,1)
..I DPTSTAT'="",DGDFN S X=DPTSTAT,DA=DGDFN D
...; Kill 'ACS' x-ref entry using ^DD kill logic
...X ^DD(2,.14,1,1,2)
...; Set corresponding data field to null
...S $P(^DPT(DGDFN,0),U,14)=""
...I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
..;
..; Update file 408.31 status field (#.03) so that 'M' trigger fires
..; correctly to populate field #.14 of patient file. DIE call used
..; vs. DBS call so that trigger fires correctly.
..S DGMTSTAT=$P($G(^TMP($J,"BADST",DGDFN,MTIEN)),U,2)
..I DGMTSTAT'="",MTIEN D
...S DA=MTIEN,DIE="^DGMT(408.31,",DR=".03////"_DGMTSTAT
...L +^DGMT(408.31,MTIEN):1
...D ^DIE
...L -^DGMT(408.31,MTIEN):1
...I $D(XPDNM) S %=$$UPCP^XPDUTL("MTIEN",MTIEN)
...S ^TMP($J,"PAT",$P($G(^DPT(DGDFN,0)),U,1)_U,MTIEN)=DGDFN_U_DPTSTAT_U_MTIEN_U_DGMTSTAT
...K ^TMP($J,"BADST",DGDFN,MTIEN)
..K DA,DR,DIE
..Q
.Q
D MBDST^DG53358M
D MES^XPDUTL("PHASE II processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
BADEN ; Cleanup those entries in the patient file where the current means
; test status field (#.14) is populated; however, there is not a means
; test on file for the patient.
N DGDFN,DGCNT
I '$D(^TMP($J,"BADEN")) D Q
.D BMES^XPDUTL("PHASE III of processing has no inconsistent data to correct")
.D BADEN^DG53358M
.D MES^XPDUTL("PHASE III processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
I $D(^TMP($J,"BADEN")) D
.D BMES^XPDUTL("Updating records in the patient file that don't have a corresponding")
.D MES^XPDUTL("means test. ")
.S DGDFN="" F DGCNT=1:1 S DGDFN=$O(^TMP($J,"BADEN",DGDFN)) Q:'+DGDFN S MTIEN="" F S MTIEN=$O(^TMP($J,"BADEN",DGDFN,MTIEN)) Q:MTIEN="" D
..I '$D(ZTQUEUED) W:'(DGCNT#100) "."
..S X=MTIEN,DA=DGDFN
..; Kill 'ACS' x-ref using DD logic
..X ^DD(2,.14,1,1,2)
..; Set data node to null
..S $P(^DPT(DGDFN,0),U,14)=""
..I $D(XPDNM) D
...S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
...S %=$$UPCP^XPDUTL("MTIEN",MTIEN)
...Q
..Q
.Q
D MES^XPDUTL("PHASE III processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
D BADEN^DG53358M
Q
DG53358 ;ALB/AEG - DG*5.3*358 POST INSTALL TO MAIL MSG ;3-5-2001
+1 ;;5.3;Registration;**358,1015**;3-5-2001;Build 21
+2 ;
+3 ; This routine is a post-installation for patch DG*5.3*358
+4 ;
+5 ; This routine will perform a number of database clean-up
+6 ; functions. The primary functionality will cleanup
+7 ; inconsistent data between the CURRENT MEANS TEST STATUS
+8 ; field (#.14) of the PATIENT file (#2) and the STATUS
+9 ; field (#.03) of the ANNUAL MEANS TEST file (#408.31). In
+10 ; all instances, data in file #408.31 is considered correct
+11 ; as the Patient file is populated via a trigger on .03 field
+12 ; of file 408.31.
+13 ;
+14 ; The second issue being cleaned up deals with those patients
+15 ; that have expired and a Means test in the status of No Longer
+16 ; Required or Required. In both instances it is possible to
+17 ; to have a test on file dated after the patient has expired.
+18 ; In this instance, these tests are not valid and will be
+19 ; purged. In the instance where the test date is on or before
+20 ; the date of death the NLR status tests' status will be
+21 ; recalculated and set to it's previous value. In the case of
+22 ; REQUIRED status and date of test is on or before DOD these
+23 ; will be reported to need completion to the user running this
+24 ; task.
+25 ;
EN ; Main entry point for post-installation.
+1 DO INIT
+2 QUIT
INIT ; Initialize tracking global and associated checkpoints.
+1 KILL ^TMP($JOB),^XTMP("DG-BADEN"),^XTMP("DG-BADST"),^XTMP("DG-DGDOA")
+2 NEW %,I,X,X1,X2
+3 ; Create Checkpoints
+4 IF $DATA(XPDNM)
Begin DoDot:1
+5 IF $$VERCP^XPDUTL("DGDFN")'>0
Begin DoDot:2
+6 SET %=$$NEWCP^XPDUTL("DGDFN","",0)
End DoDot:2
+7 IF $$VERCP^XPDUTL("MTIEN")'>0
Begin DoDot:2
+8 SET %=$$NEWCP^XPDUTL("MTIEN","",0)
End DoDot:2
+9 IF $$VERCP^XPDUTL("DGDOA")'>0
Begin DoDot:2
+10 SET %=$$NEWCP^XPDUTL("DGDOA","",0)
End DoDot:2
End DoDot:1
+11 ;
+12 ; initialize tracking global(s)
+13 FOR I="BADEN","BADST","DGDOA"
Begin DoDot:1
+14 IF $DATA(^XTMP("DG-"_I))
QUIT
+15 SET X1=DT
SET X2=30
DO C^%DTC
+16 SET ^XTMP("DG-"_I,0)=X_U_$$DT^XLFDT_"^DG*5.3*358 POST INSTALL "
+17 SET ^XTMP("DG_"_I,0)=^XTMP("DG-"_I,0)_$SELECT(I="BADEN":"No means test on file",I="BADST":"Records corrected",1:"errors")
End DoDot:1
+18 IF '$DATA(XPDNM)
SET (^XTMP("DG-BADEN",1),^XTMP("DG-BADST",1),^XTMP("DG-DGDOA",1))=0
+19 ; check status and if root checkpoint has not completed start clean up
+20 IF $DATA(XPDNM)
SET %=$$VERCP^XPDUTL("DGDFN")
Begin DoDot:1
+21 IF '$DATA(^XTMP("DG-BADEN",1))
SET ^XTMP("DG-BADEN",1)=0
+22 IF '$DATA(^XTMP("DG-BADST",1))
SET ^XTMP("DG-BADST",1)=0
+23 IF '$DATA(^XTMP("DG-DGDOA",1))
SET ^XTMP("DG-DGDOA",1)=0
End DoDot:1
+24 IF $GET(%)=""
SET %=0
+25 IF %=0
DO EN1
+26 QUIT
EN1 ; Control logic flow and implement cleanup in phases
+1 DO LOOP
DO PAT
DO BADEN
+2 DO DOAN^DG53358A
+3 DO DOAR^DG53358A
+4 IF $DATA(XPDNM)
Begin DoDot:1
+5 SET %=$$COMCP^XPDUTL("DGDFN")
+6 SET %=$$COMCP^XPDUTL("MTIEN")
+7 SET %=$$COMCP^XPDUTL("DGDOA")
End DoDot:1
+8 QUIT
LOOP ; Start loop in patient file to search for records with status
+1 ; inconsistency problems as well as DOD issues.
+2 ;
+3 DO BMES^XPDUTL("POST INSTALLATION PROCESSING")
+4 DO MES^XPDUTL("------------------------------")
+5 DO MES^XPDUTL("Once the post installation has completed, six mail messages")
+6 DO MES^XPDUTL("will be generated to report the number of inconsistencies")
+7 DO MES^XPDUTL("corrected as well as the Means Tests requiring completion.")
+8 DO BMES^XPDUTL("PHASE I - Search engine started at "_$$FMTE^XLFDT($$NOW^XLFDT))
+9 DO BMES^XPDUTL("Each "_"'.'"_" represents approximately 200 records ")
+10 NEW DGDFN,MTIEN,DGMTDT,DGCNT,DGDOA
+11 SET (DGDFN,MTIEN,DGMTDT)=""
+12 SET DGDFN=0
FOR DGCNT=1:1
SET DGDFN=$ORDER(^DPT(DGDFN))
IF '+DGDFN
QUIT
Begin DoDot:1
+13 IF '$DATA(ZTQUEUED)
IF '(DGCNT#200)
WRITE "."
+14 ; If patient does NOT have a date of death process
+15 Begin DoDot:2
+16 NEW DPTSTAT,DGMTSTAT,DGMTDT
+17 ; If a MT is on file, check the status field (.03) against the
+18 ; current MT status field (.14) in patient file. They should match.
+19 SET MTIEN=$$LST^DGMTU(DGDFN,"",1)
+20 IF +$GET(MTIEN)
Begin DoDot:3
+21 SET DPTSTAT=$PIECE($GET(^DPT(DGDFN,0)),U,14)
SET DGMTSTAT=$PIECE($GET(^DGMT(408.31,+MTIEN,0)),U,3)
+22 IF DPTSTAT'=DGMTSTAT
Begin DoDot:4
+23 SET ^TMP($JOB,"BADST",DGDFN,+MTIEN)=DPTSTAT_U_DGMTSTAT
+24 ; increment the counter for this inconsistency type
+25 SET ^XTMP("DG-BADST",1)=$GET(^XTMP("DG-BADST",1))+1
+26 QUIT
End DoDot:4
+27 QUIT
End DoDot:3
+28 ; update checkpoint
+29 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("MTIEN",+MTIEN)
+30 ; If no means test is on file but the current means test status field
+31 ; is populated, there is a consistency problem. Store this info. to
+32 ; to be used for later cleanup.
+33 IF '+$GET(MTIEN)
Begin DoDot:3
+34 SET DPTSTAT=$PIECE($GET(^DPT(DGDFN,0)),U,14)
+35 IF +DPTSTAT
Begin DoDot:4
+36 SET ^TMP($JOB,"BADEN",DGDFN,DPTSTAT)=""
+37 ; Increment Counter
+38 SET ^XTMP("DG-BADEN",1)=$GET(^XTMP("DG-BADEN",1))+1
+39 QUIT
End DoDot:4
+40 QUIT
End DoDot:3
+41 QUIT
End DoDot:2
+42 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
+43 ; Process if a date of death exists.
+44 NEW DGDT,DGIDT,DGMTI,DGMTST,DGNODE
+45 IF $PIECE($GET(^DPT(DGDFN,.35)),U)'=""
Begin DoDot:2
+46 SET DGDOA=$PIECE($GET(^DPT(DGDFN,.35)),U)
+47 SET DGDT=""
SET DGIDT=$SELECT($GET(DGDT)>0:-DGDT,1:-DT)
IF '$PIECE(DGIDT,".",2)
SET DGIDT=DGIDT_.2359
+48 FOR
SET DGIDT=+$ORDER(^DGMT(408.31,"AID",1,DGDFN,DGIDT))
IF 'DGIDT
QUIT
Begin DoDot:3
+49 FOR DGMTI=0:0
SET DGMTI=$ORDER(^DGMT(408.31,"AID",1,DGDFN,DGIDT,DGMTI))
IF 'DGMTI
QUIT
Begin DoDot:4
+50 SET DGNODE=$GET(^DGMT(408.31,DGMTI,0))
SET DGMTST=$PIECE(DGNODE,U,3)
+51 IF $PIECE($GET(DGNODE),U,19)'=1
QUIT
+52 IF DGNODE
IF $GET(^("PRIM"))
SET MTIEN=DGMTI_"^"_$PIECE(DGNODE,U)_"^"_$$MTS^DGMTU(DGDFN,DGMTST)_"^"_$PIECE(DGNODE,U,23)
+53 ; Process NO LONGER REQUIRED status expired patients
+54 IF $GET(MTIEN)
IF $PIECE(MTIEN,U,4)="N"
Begin DoDot:5
+55 SET ^TMP($JOB,"DGDOA-N",DGDFN,$PIECE(MTIEN,U,2),DGDOA)=$GET(MTIEN)
+56 ; Increment NLR counter
+57 SET ^XTMP("DG-DGDOA",1)=$GET(^XTMP("DG-DGDOA",1))+1
+58 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDOA",DGDOA)
End DoDot:5
+59 ; Process REQUIRED status expired patients.
+60 IF $GET(MTIEN)
IF $PIECE(MTIEN,U,4)="R"
Begin DoDot:5
+61 SET ^TMP($JOB,"DGDOA-R",DGDFN,$PIECE(MTIEN,U,2),DGDOA)=$GET(MTIEN)
+62 SET ^XTMP("DG-DGDOA",1)=$GET(^XTMP("DG-DGDOA",1))+1
+63 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDOA",DGDOA)
End DoDot:5
+64 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("MTIEN",+MTIEN)
End DoDot:4
End DoDot:3
End DoDot:2
+65 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
End DoDot:1
+66 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
+67 DO BMES^XPDUTL("Total Records reviewed - "_(DGCNT-1))
+68 DO MES^XPDUTL("PHASE I search of the patient file completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
+69 QUIT
PAT ; Use data we stored in ^TMP($J,"BADST" node and clean up the data
+1 IF '$DATA(^TMP($JOB,"BADST"))
Begin DoDot:1
+2 DO BMES^XPDUTL("PHASE II of processing has no inconsistent data to correct")
+3 DO MBDST^DG53358M
+4 DO MES^XPDUTL("PHASE II processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
End DoDot:1
QUIT
+5 IF $DATA(^TMP($JOB,"BADST"))
Begin DoDot:1
+6 DO BMES^XPDUTL("PHASE II of the cleanup processing started on "_$$FMTE^XLFDT($$NOW^XLFDT))
+7 DO BMES^XPDUTL("This phase of the process will cleanup those entries in the patient file")
+8 DO MES^XPDUTL("that have inconsistent status entries in the CURRENT MEANS")
+9 DO MES^XPDUTL("TEST STATUS field (#.14) of the PATIENT file (#2) ")
+10 NEW DGDFN,MTIEN,DGCNT,DGMTSTAT
+11 SET (DGDFN,MTIEN)=""
+12 FOR DGCNT=1:1
SET DGDFN=$ORDER(^TMP($JOB,"BADST",DGDFN))
IF '+DGDFN
QUIT
SET MTIEN=""
FOR
SET MTIEN=$ORDER(^TMP($JOB,"BADST",DGDFN,MTIEN))
IF MTIEN=""
QUIT
Begin DoDot:2
+13 IF '$DATA(ZTQUEUED)
IF '(DGCNT#100)
WRITE "."
+14 SET DPTSTAT=$PIECE($GET(^TMP($JOB,"BADST",DGDFN,MTIEN)),U,1)
+15 IF DPTSTAT'=""
IF DGDFN
SET X=DPTSTAT
SET DA=DGDFN
Begin DoDot:3
+16 ; Kill 'ACS' x-ref entry using ^DD kill logic
+17 XECUTE ^DD(2,.14,1,1,2)
+18 ; Set corresponding data field to null
+19 SET $PIECE(^DPT(DGDFN,0),U,14)=""
+20 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
End DoDot:3
+21 ;
+22 ; Update file 408.31 status field (#.03) so that 'M' trigger fires
+23 ; correctly to populate field #.14 of patient file. DIE call used
+24 ; vs. DBS call so that trigger fires correctly.
+25 SET DGMTSTAT=$PIECE($GET(^TMP($JOB,"BADST",DGDFN,MTIEN)),U,2)
+26 IF DGMTSTAT'=""
IF MTIEN
Begin DoDot:3
+27 SET DA=MTIEN
SET DIE="^DGMT(408.31,"
SET DR=".03////"_DGMTSTAT
+28 LOCK +^DGMT(408.31,MTIEN):1
+29 DO ^DIE
+30 LOCK -^DGMT(408.31,MTIEN):1
+31 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("MTIEN",MTIEN)
+32 SET ^TMP($JOB,"PAT",$PIECE($GET(^DPT(DGDFN,0)),U,1)_U,MTIEN)=DGDFN_U_DPTSTAT_U_MTIEN_U_DGMTSTAT
+33 KILL ^TMP($JOB,"BADST",DGDFN,MTIEN)
End DoDot:3
+34 KILL DA,DR,DIE
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
+37 DO MBDST^DG53358M
+38 DO MES^XPDUTL("PHASE II processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
+39 QUIT
BADEN ; Cleanup those entries in the patient file where the current means
+1 ; test status field (#.14) is populated; however, there is not a means
+2 ; test on file for the patient.
+3 NEW DGDFN,DGCNT
+4 IF '$DATA(^TMP($JOB,"BADEN"))
Begin DoDot:1
+5 DO BMES^XPDUTL("PHASE III of processing has no inconsistent data to correct")
+6 DO BADEN^DG53358M
+7 DO MES^XPDUTL("PHASE III processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
End DoDot:1
QUIT
+8 IF $DATA(^TMP($JOB,"BADEN"))
Begin DoDot:1
+9 DO BMES^XPDUTL("Updating records in the patient file that don't have a corresponding")
+10 DO MES^XPDUTL("means test. ")
+11 SET DGDFN=""
FOR DGCNT=1:1
SET DGDFN=$ORDER(^TMP($JOB,"BADEN",DGDFN))
IF '+DGDFN
QUIT
SET MTIEN=""
FOR
SET MTIEN=$ORDER(^TMP($JOB,"BADEN",DGDFN,MTIEN))
IF MTIEN=""
QUIT
Begin DoDot:2
+12 IF '$DATA(ZTQUEUED)
IF '(DGCNT#100)
WRITE "."
+13 SET X=MTIEN
SET DA=DGDFN
+14 ; Kill 'ACS' x-ref using DD logic
+15 XECUTE ^DD(2,.14,1,1,2)
+16 ; Set data node to null
+17 SET $PIECE(^DPT(DGDFN,0),U,14)=""
+18 IF $DATA(XPDNM)
Begin DoDot:3
+19 SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
+20 SET %=$$UPCP^XPDUTL("MTIEN",MTIEN)
+21 QUIT
End DoDot:3
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 DO MES^XPDUTL("PHASE III processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
+25 DO BADEN^DG53358M
+26 QUIT
