- DG53461 ;ALB/AEG - DG*5.3*461 POST-INSTALLATION ;7-2-2002
- ;;5.3;Registration;**461,1015**;Aug 13, 1993;Build 21
- ;
- ; This cleanup consists of 1 issue dealing with duplicate
- ; CD (Catestropic Disability) Procedure Codes. The patient
- ; File (#2) will be searched for entries on living patients
- ; who have multiple entries associated with the same procedure
- ; and extremity.
- ;
- EN ; Main Entry Point.
- D INIT
- Q
- INIT ; Initialize Tracking Global and associated checkpoints.
- K ^TMP($J),^XTMP("DG-DFN"),^XTMP("DG-P1")
- N %,I,X,X1,X2
- ; Create Checkpoints.
- I $D(XPDNM) D
- .I $$VERCP^XPDUTL("DFN")'>0 D
- ..S %=$$NEWCP^XPDUTL("DFN","",0)
- .I $$VERCP^XPDUTL("P1")'>0 D
- ..S %=$$NEWCP^XPDUTL("P1","",0)
- ; Initialize the tracking global.
- F I="DFN","P1" 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*461 POST INSTALL "
- .S ^XTMP("DG-"_I,0)=^XTMP("DG-"_I,0)_$S(I="DFN":"Patient records",I="P1":"Duplicate Procedures",1:"errors")
- I '$D(XPDNM) D
- .S ^XTMP("DG-DFN",1)=0
- .S ^XTMP("DG-P1",1)=0
- ;
- ; Check status. If root checkpoint has not completed start the cleanup
- I $D(XPDNM) S %=$$VERCP^XPDUTL("DFN") D
- .I '$D(^XTMP("DG-DFN",1)) S ^XTMP("DG-DFN",1)=0
- .I '$D(^XTMP("DG-P1",1)) S ^XTMP("DG-P1",1)=0
- I $G(%)="" S %=0
- I %=0 D EN1
- Q
- ;
- EN1 ; Control process flow from this point forward.
- D LOOP,DUPL,PURGE
- N %
- ; Complete checkpoints and get out.
- S %=$$COMCP^XPDUTL("DFN"),%=$$COMCP^XPDUTL("P1")
- D CLEAN
- Q
- LOOP ; Initial Pass through the patient file to determine which records have
- ; corrupted data.
- D BMES^XPDUTL("POST INSTALLATION PROCESSING")
- D MES^XPDUTL("----------------------------")
- N MESS D MESS^DG53461U D MES^XPDUTL(.MESS)
- N DFN,DGCNT,DGDOD
- D BMES^XPDUTL("SEARCH ENGINE STARTED AT "_$$FMTE^XLFDT($$NOW^XLFDT))
- I '$D(ZTQUEUED) D MES^XPDUTL("Each `.` represents 200 records ...")
- S DFN=0 F DGCNT=1:1 S DFN=$O(^DPT(DFN)) Q:'+DFN D
- .I '$D(ZTQUEUED) W:'(DGCNT#200) "."
- .S DGDOD=$P($G(^DPT(DFN,.35)),U)
- .; Ignore patients who have a date of death on file.
- .D:'+DGDOD
- ..I $D(^DPT(DFN,.397,0)),$P(^DPT(DFN,.397,0),U,4)>0 D
- ...N PIEN,P1,I
- ...S PIEN="" F S PIEN=$O(^DPT(DFN,.397,"B",PIEN)) Q:'+PIEN S P1="" F S P1=$O(^DPT(DFN,.397,"B",PIEN,P1)) Q:'+P1 D
- ....D SETTMP(DFN,P1)
- ....; Update Checkpoint
- ....N %
- ....I $D(XPDNM) S %=$$UPCP^XPDUTL("P1",P1)
- ....Q
- ...Q
- ..Q
- .; Update DFN CheckPoint
- .N %
- .I $D(XPDNM) S %=$$UPCP^XPDUTL("DFN",DFN)
- .Q
- Q
- ;
- SETTMP(DFN,P1) ; Return data value of specific entry being looked at
- S ^TMP($J,"DFN",DFN)=$P($G(^DPT(DFN,.397,0)),U,4)
- S ^TMP($J,"PCODE",DFN,P1)=$G(^DPT(DFN,.397,P1,0))
- Q
- DUPL ; Clean-up Duplicate Entries.
- D BMES^XPDUTL("PARSING DATA TO LOCATE DUPLICATE ENTRIES ...")
- N DFN,COUNT,I,IJ,VAL,VAL1
- S DFN=""
- F S DFN=$O(^TMP($J,"DFN",DFN)) Q:'+DFN D
- .S COUNT=$G(^TMP($J,"DFN",DFN))
- .F I=1:1:COUNT S VAL=$G(^TMP($J,"PCODE",DFN,I)) F IJ=1:1:COUNT S VAL1=$G(^TMP($J,"PCODE",DFN,IJ)) D
- ..I I'=IJ,'$D(^UTILITY("SCRATCH",$J,DFN,IJ,I)) S ^UTILITY("SCRATCH",$J,DFN,I,IJ)=COUNT
- ..I VAL=VAL1,I'=IJ,'$D(^UTILITY("SCRATCH",$J,DFN,IJ,I)) D
- ...I I>IJ S ^TMP("DUPLICATE",$J,DFN,I)=VAL,^UTILITY($J,"DUP",$P($G(^DPT(DFN,0)),U,1),DFN,VAL)=""
- ...I IJ>I S ^TMP("DUPLICATE",$J,DFN,IJ)=VAL1,^UTILITY($J,"DUP",$P($G(^DPT(DFN,0)),U,1),DFN,VAL1)=""
- ...Q
- ..Q
- .Q
- K ^TMP($J),^UTILITY("SCRATCH",$J)
- Q
- PURGE ; Cleanup duplicate CD procedures and report on those procedures.
- I '$D(^TMP("DUPLICATE",$J)) D Q
- .D M1^DG53461U
- I $D(^TMP("DUPLICATE",$J)) D
- .D BMES^XPDUTL("PURGING DUPLICATE ENTRIES ...")
- .N DFN,PIEN,VAL
- .S (DFN,PIEN)=""
- .F S DFN=$O(^TMP("DUPLICATE",$J,DFN)) Q:'+DFN D
- ..S PIEN="" F S PIEN=$O(^TMP("DUPLICATE",$J,DFN,PIEN)) Q:'+PIEN D
- ...N DATA,DGENDA
- ...S DATA(.01)="@",DGENDA=PIEN,DGENDA(1)=DFN
- ...I '$$UPD^DGENDBS(2.397,.DGENDA,.DATA,.ERROR) D
- ....S ^TMP("ERROR",$J,DFN,ERROR)=""
- ....K ^UTILITY($J,"DUP",$P($G(^DPT(DFN,0)),U,1))
- ....Q
- ...Q
- ..Q
- .Q
- I $D(^UTILITY($J,"DUP")) D M2^DG53461U
- I $D(^TMP("ERROR",$J)) D M3^DG53461U
- Q
- CLEAN ; Cleanup symbol table / temp globals and get out.
- K ^TMP($J),^UTILITY($J),^XTMP("DG-DFN"),^XTMP("DG-P1")
- K MESS,XMZ,ZTQUEUED,ERROR
- Q
- DG53461 ;ALB/AEG - DG*5.3*461 POST-INSTALLATION ;7-2-2002
- +1 ;;5.3;Registration;**461,1015**;Aug 13, 1993;Build 21
- +2 ;
- +3 ; This cleanup consists of 1 issue dealing with duplicate
- +4 ; CD (Catestropic Disability) Procedure Codes. The patient
- +5 ; File (#2) will be searched for entries on living patients
- +6 ; who have multiple entries associated with the same procedure
- +7 ; and extremity.
- +8 ;
- EN ; Main Entry Point.
- +1 DO INIT
- +2 QUIT
- INIT ; Initialize Tracking Global and associated checkpoints.
- +1 KILL ^TMP($JOB),^XTMP("DG-DFN"),^XTMP("DG-P1")
- +2 NEW %,I,X,X1,X2
- +3 ; Create Checkpoints.
- +4 IF $DATA(XPDNM)
- Begin DoDot:1
- +5 IF $$VERCP^XPDUTL("DFN")'>0
- Begin DoDot:2
- +6 SET %=$$NEWCP^XPDUTL("DFN","",0)
- End DoDot:2
- +7 IF $$VERCP^XPDUTL("P1")'>0
- Begin DoDot:2
- +8 SET %=$$NEWCP^XPDUTL("P1","",0)
- End DoDot:2
- End DoDot:1
- +9 ; Initialize the tracking global.
- +10 FOR I="DFN","P1"
- Begin DoDot:1
- +11 IF $DATA(^XTMP("DG-"_I))
- QUIT
- +12 SET X1=DT
- SET X2=30
- DO C^%DTC
- +13 SET ^XTMP("DG-"_I,0)=X_U_$$DT^XLFDT_"^DG*5.3*461 POST INSTALL "
- +14 SET ^XTMP("DG-"_I,0)=^XTMP("DG-"_I,0)_$SELECT(I="DFN":"Patient records",I="P1":"Duplicate Procedures",1:"errors")
- End DoDot:1
- +15 IF '$DATA(XPDNM)
- Begin DoDot:1
- +16 SET ^XTMP("DG-DFN",1)=0
- +17 SET ^XTMP("DG-P1",1)=0
- End DoDot:1
- +18 ;
- +19 ; Check status. If root checkpoint has not completed start the cleanup
- +20 IF $DATA(XPDNM)
- SET %=$$VERCP^XPDUTL("DFN")
- Begin DoDot:1
- +21 IF '$DATA(^XTMP("DG-DFN",1))
- SET ^XTMP("DG-DFN",1)=0
- +22 IF '$DATA(^XTMP("DG-P1",1))
- SET ^XTMP("DG-P1",1)=0
- End DoDot:1
- +23 IF $GET(%)=""
- SET %=0
- +24 IF %=0
- DO EN1
- +25 QUIT
- +26 ;
- EN1 ; Control process flow from this point forward.
- +1 DO LOOP
- DO DUPL
- DO PURGE
- +2 NEW %
- +3 ; Complete checkpoints and get out.
- +4 SET %=$$COMCP^XPDUTL("DFN")
- SET %=$$COMCP^XPDUTL("P1")
- +5 DO CLEAN
- +6 QUIT
- LOOP ; Initial Pass through the patient file to determine which records have
- +1 ; corrupted data.
- +2 DO BMES^XPDUTL("POST INSTALLATION PROCESSING")
- +3 DO MES^XPDUTL("----------------------------")
- +4 NEW MESS
- DO MESS^DG53461U
- DO MES^XPDUTL(.MESS)
- +5 NEW DFN,DGCNT,DGDOD
- +6 DO BMES^XPDUTL("SEARCH ENGINE STARTED AT "_$$FMTE^XLFDT($$NOW^XLFDT))
- +7 IF '$DATA(ZTQUEUED)
- DO MES^XPDUTL("Each `.` represents 200 records ...")
- +8 SET DFN=0
- FOR DGCNT=1:1
- SET DFN=$ORDER(^DPT(DFN))
- IF '+DFN
- QUIT
- Begin DoDot:1
- +9 IF '$DATA(ZTQUEUED)
- IF '(DGCNT#200)
- WRITE "."
- +10 SET DGDOD=$PIECE($GET(^DPT(DFN,.35)),U)
- +11 ; Ignore patients who have a date of death on file.
- +12 IF '+DGDOD
- Begin DoDot:2
- +13 IF $DATA(^DPT(DFN,.397,0))
- IF $PIECE(^DPT(DFN,.397,0),U,4)>0
- Begin DoDot:3
- +14 NEW PIEN,P1,I
- +15 SET PIEN=""
- FOR
- SET PIEN=$ORDER(^DPT(DFN,.397,"B",PIEN))
- IF '+PIEN
- QUIT
- SET P1=""
- FOR
- SET P1=$ORDER(^DPT(DFN,.397,"B",PIEN,P1))
- IF '+P1
- QUIT
- Begin DoDot:4
- +16 DO SETTMP(DFN,P1)
- +17 ; Update Checkpoint
- +18 NEW %
- +19 IF $DATA(XPDNM)
- SET %=$$UPCP^XPDUTL("P1",P1)
- +20 QUIT
- End DoDot:4
- +21 QUIT
- End DoDot:3
- +22 QUIT
- End DoDot:2
- +23 ; Update DFN CheckPoint
- +24 NEW %
- +25 IF $DATA(XPDNM)
- SET %=$$UPCP^XPDUTL("DFN",DFN)
- +26 QUIT
- End DoDot:1
- +27 QUIT
- +28 ;
- SETTMP(DFN,P1) ; Return data value of specific entry being looked at
- +1 SET ^TMP($JOB,"DFN",DFN)=$PIECE($GET(^DPT(DFN,.397,0)),U,4)
- +2 SET ^TMP($JOB,"PCODE",DFN,P1)=$GET(^DPT(DFN,.397,P1,0))
- +3 QUIT
- DUPL ; Clean-up Duplicate Entries.
- +1 DO BMES^XPDUTL("PARSING DATA TO LOCATE DUPLICATE ENTRIES ...")
- +2 NEW DFN,COUNT,I,IJ,VAL,VAL1
- +3 SET DFN=""
- +4 FOR
- SET DFN=$ORDER(^TMP($JOB,"DFN",DFN))
- IF '+DFN
- QUIT
- Begin DoDot:1
- +5 SET COUNT=$GET(^TMP($JOB,"DFN",DFN))
- +6 FOR I=1:1:COUNT
- SET VAL=$GET(^TMP($JOB,"PCODE",DFN,I))
- FOR IJ=1:1:COUNT
- SET VAL1=$GET(^TMP($JOB,"PCODE",DFN,IJ))
- Begin DoDot:2
- +7 IF I'=IJ
- IF '$DATA(^UTILITY("SCRATCH",$JOB,DFN,IJ,I))
- SET ^UTILITY("SCRATCH",$JOB,DFN,I,IJ)=COUNT
- +8 IF VAL=VAL1
- IF I'=IJ
- IF '$DATA(^UTILITY("SCRATCH",$JOB,DFN,IJ,I))
- Begin DoDot:3
- +9 IF I>IJ
- SET ^TMP("DUPLICATE",$JOB,DFN,I)=VAL
- SET ^UTILITY($JOB,"DUP",$PIECE($GET(^DPT(DFN,0)),U,1),DFN,VAL)=""
- +10 IF IJ>I
- SET ^TMP("DUPLICATE",$JOB,DFN,IJ)=VAL1
- SET ^UTILITY($JOB,"DUP",$PIECE($GET(^DPT(DFN,0)),U,1),DFN,VAL1)=""
- +11 QUIT
- End DoDot:3
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 KILL ^TMP($JOB),^UTILITY("SCRATCH",$JOB)
- +15 QUIT
- PURGE ; Cleanup duplicate CD procedures and report on those procedures.
- +1 IF '$DATA(^TMP("DUPLICATE",$JOB))
- Begin DoDot:1
- +2 DO M1^DG53461U
- End DoDot:1
- QUIT
- +3 IF $DATA(^TMP("DUPLICATE",$JOB))
- Begin DoDot:1
- +4 DO BMES^XPDUTL("PURGING DUPLICATE ENTRIES ...")
- +5 NEW DFN,PIEN,VAL
- +6 SET (DFN,PIEN)=""
- +7 FOR
- SET DFN=$ORDER(^TMP("DUPLICATE",$JOB,DFN))
- IF '+DFN
- QUIT
- Begin DoDot:2
- +8 SET PIEN=""
- FOR
- SET PIEN=$ORDER(^TMP("DUPLICATE",$JOB,DFN,PIEN))
- IF '+PIEN
- QUIT
- Begin DoDot:3
- +9 NEW DATA,DGENDA
- +10 SET DATA(.01)="@"
- SET DGENDA=PIEN
- SET DGENDA(1)=DFN
- +11 IF '$$UPD^DGENDBS(2.397,.DGENDA,.DATA,.ERROR)
- Begin DoDot:4
- +12 SET ^TMP("ERROR",$JOB,DFN,ERROR)=""
- +13 KILL ^UTILITY($JOB,"DUP",$PIECE($GET(^DPT(DFN,0)),U,1))
- +14 QUIT
- End DoDot:4
- +15 QUIT
- End DoDot:3
- +16 QUIT
- End DoDot:2
- +17 QUIT
- End DoDot:1
- +18 IF $DATA(^UTILITY($JOB,"DUP"))
- DO M2^DG53461U
- +19 IF $DATA(^TMP("ERROR",$JOB))
- DO M3^DG53461U
- +20 QUIT
- CLEAN ; Cleanup symbol table / temp globals and get out.
- +1 KILL ^TMP($JOB),^UTILITY($JOB),^XTMP("DG-DFN"),^XTMP("DG-P1")
- +2 KILL MESS,XMZ,ZTQUEUED,ERROR
- +3 QUIT
