Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53P593

DG53P593.m

Go to the documentation of this file.
  1. DG53P593 ;BAY/JAT - Patient File Cleanup; 2/22/1999 ; 6/24/04 3:43pm
  1. ;;5.3;Registration;**593**;Aug 13,1993
  1. Q
  1. ;
  1. CLEANUP ;This entry point will do the cleanup.
  1. ;
  1. N DGENSKIP
  1. S DGENSKIP=0
  1. W !,"This is a one-time cleanup of the Patient File."
  1. W !,"Certain records which were created in error will be deleted."
  1. N X1,X2
  1. K ^XTMP("DG53P593",$J)
  1. S X1=DT,X2=90 D C^%DTC
  1. S ^XTMP("DG53P593",$J,0)=X_"^"_DT_"^Patient File cleanup"
  1. I $$DEVICE() D ENTER
  1. Q
  1. ;
  1. REPORT ;This entry point was provided for testing, so that before
  1. ;patient records are deleted the site can have a list of
  1. ;the DFN's that would be deleted.
  1. ;
  1. ;Use this entry point to report on what the cleanup would do.
  1. ;No changes will be made to the database.
  1. ;
  1. N DGENSKIP
  1. S DGENSKIP=1
  1. W !,"This is a preliminary report by DFN of the Patient file"
  1. W !,"records which would be deleted by the cleanup."
  1. N X1,X2
  1. K ^XTMP("DG53P593",$J)
  1. S X1=DT,X2=90 D C^%DTC
  1. S ^XTMP("DG53P593",$J,0)=X_"^"_DT_"^Patient File cleanup"
  1. I $$DEVICE() D ENTER
  1. Q
  1. ;
  1. ENTER ;
  1. ;
  1. D DELETE(DGENSKIP)
  1. D:(DGENSKIP) ^%ZISC
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. DEVICE() ;
  1. ;Description: allows the user to select a device.
  1. ;
  1. ;Output:
  1. ; Function Value - Returns 0 if the user decides not to print or to
  1. ; queue the report, 1 otherwise.
  1. ;
  1. N OK,IOP,POP,%ZIS
  1. S OK=1
  1. S %ZIS="MQ"
  1. D ^%ZIS
  1. S:POP OK=0
  1. D:OK&$D(IO("Q"))
  1. .N ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP
  1. .S ZTRTN="ENTER^DG53P593",ZTDESC=$S(DGENSKIP:"Report",1:"Cleanup")_" of Incomplete Patient Records"
  1. .S ZTSAVE("DGENSKIP")=""
  1. .D ^%ZTLOAD
  1. .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1. .D HOME^%ZIS
  1. .S OK=0
  1. Q OK
  1. ;
  1. DELETE(DGENSKIP) ;
  1. ;This will delete bogus patient records --
  1. ;
  1. ;Input: If DGENSKIP=1, the records will not be deleted,
  1. ;just reported.
  1. ;
  1. N DFN,SUB,GOOD,COUNT,DGNAME,DGDEL,DGSORT,DGVAL,DGFDA,DGERR
  1. S (COUNT,DFN)=0
  1. F S DFN=$O(^DPT(DFN)) Q:'DFN D
  1. .; merged record
  1. .I $D(^DPT(DFN,-9)) Q
  1. .; in process of being merged
  1. .I $P($G(^DPT(DFN,0)),U)["MERGING INTO" Q
  1. .; usual good patient record
  1. .I $D(^DPT(DFN,0)) S DGNAME=$P($G(^DPT(DFN,0)),U) I DGNAME'="",$D(^DPT("B",DGNAME,DFN)) Q
  1. .; evaluate if record related to DG*5.3*578
  1. .D EVAL578
  1. .; evaluate if record related to DG*5.3*222
  1. .S GOOD=0
  1. .S SUB=""
  1. .F S SUB=$O(^DPT(DFN,SUB)) Q:SUB="" D
  1. ..I (SUB'=.3),(SUB'=.38),(SUB'=.52) S GOOD=1 Q
  1. .I 'GOOD D DIKDEL Q
  1. .I DGDEL D DIKDEL
  1. ;
  1. D PRINT
  1. Q
  1. ;
  1. EVAL578 ;
  1. S DGDEL=0
  1. N DGCNT,DGNODE,DGSSN,DGNEWIEN,DGMPI
  1. I '$D(^DPT(DFN,0)) Q
  1. S DGNODE=""
  1. S DGCNT=0
  1. F S DGNODE=$O(^DPT(DFN,DGNODE)) Q:DGNODE="" S DGCNT=DGCNT+1
  1. ; there must be minimal data, so skip if too many nodes
  1. Q:DGCNT>7
  1. I DGNAME="" S DGDEL=DGDEL+1
  1. I DGNAME'="",'$D(^DPT("B",DGNAME,DFN)) S DGDEL=DGDEL+1
  1. S DGSSN=$P($G(^DPT(DFN,0)),U,9)
  1. I DGSSN="" S DGDEL=DGDEL+1
  1. I DGSSN'="",'$D(^DPT("SSN",DGSSN,DFN)) S DGDEL=DGDEL+1 D
  1. .S DGNEWIEN=0
  1. .F S DGNEWIEN=$O(^DPT("SSN",DGSSN,DGNEWIEN)) Q:'DGNEWIEN I DGNEWIEN S DGDEL=DGDEL+1
  1. S DGMPI=$E($P($G(^DPT(DFN,"MPI")),U),1,3)
  1. I DGMPI="" S DGDEL=DGDEL+1
  1. ; checking if only local ICN
  1. I DGMPI=+$$SITE^VASITE() S DGDEL=DGDEL+1
  1. I DGDEL>1 Q
  1. S DGDEL=0
  1. Q
  1. ;
  1. DIKDEL ;
  1. S COUNT=COUNT+1
  1. S DGSORT=$S('GOOD:2,1:1)
  1. S ^XTMP("DG53P593",$J,DGSORT,DFN)=$S(DGSORT=1:"Related to DG*5.3*578",1:"Related to DG*5.3*222")
  1. I 'DGENSKIP D
  1. .D DELEXE
  1. .I '$D(^DPT(DFN,0)) D Q
  1. ..S DA=DFN,DIK="^DPT(" D ^DIK K DA,DIK
  1. .I $P($G(^DPT(DFN,0)),U)="" K ^DPT(DFN) Q
  1. .S DGVAL="@"
  1. .S DGFDA(2,DFN_",",.01)=DGVAL
  1. .D FILE^DIE("","DGFDA","DGERR")
  1. Q
  1. ;
  1. DELEXE ; Delete exceptions on file for patient record being removed.
  1. S EXCT=""
  1. F S EXCT=$O(^RGHL7(991.1,"ADFN",EXCT)) Q:EXCT="" D
  1. . I $D(^RGHL7(991.1,"ADFN",EXCT,DFN)) D
  1. .. S IEN=0
  1. .. F S IEN=$O(^RGHL7(991.1,"ADFN",EXCT,DFN,IEN)) Q:'IEN D
  1. ... S IEN2=0
  1. ... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCT,DFN,IEN,IEN2)) Q:'IEN2 D
  1. .... S NUM="" S NUM=$P(^RGHL7(991.1,IEN,1,0),"^",4)
  1. .... I NUM=1 D
  1. ..... L +^RGHL7(991.1,IEN):10
  1. ..... S DIK="^RGHL7(991.1,",DA=IEN
  1. ..... D ^DIK K DIK,DA
  1. ..... L -^RGHL7(991.1,IEN)
  1. .... E I NUM>1 D DELE
  1. K EXCT,IEN,IEN2,NUM
  1. Q
  1. DELE ; delete exception
  1. L +^RGHL7(991.1,IEN):10
  1. S DA(1)=IEN,DA=IEN2
  1. S DIK="^RGHL7(991.1,"_DA(1)_",1,"
  1. D ^DIK K DIK,DA
  1. L -^RGHL7(991.1,IEN)
  1. Q
  1. PRINT ;
  1. U IO
  1. N DGDDT,DGQUIT,DGPG
  1. S DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")
  1. S (DGQUIT,DGPG)=0
  1. D HEAD
  1. I '$G(COUNT) D Q
  1. .W !!!,?20,"*** No records to report ***"
  1. W !!,"*** COUNT OF BAD PATIENT RECORDS"_$S(DGENSKIP:"",1:" DELETED")_": ",COUNT," ***",!!
  1. S DGSORT=0
  1. F S DGSORT=$O(^XTMP("DG53P593",$J,DGSORT)) Q:'DGSORT D Q:DGQUIT
  1. .S DFN=0
  1. .F S DFN=$O(^XTMP("DG53P593",$J,DGSORT,DFN)) Q:'DFN D Q:DGQUIT
  1. ..I $Y>(IOSL-4) D HEAD
  1. ..W ?2,DFN,?15,$G(^XTMP("DG53P593",$J,DGSORT,DFN)),!
  1. ;
  1. I DGQUIT W:$D(ZTQUEUED) !!,"Report stopped at user's request" Q
  1. I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
  1. I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
  1. Q:DGQUIT
  1. S DGPG=$G(DGPG)+1
  1. W @IOF,!,DGDDT,?15,"DG*5.3*593 Patient File Cleanup Utility",?70,"Page:",$J(DGPG,5),! K X S $P(X,"-",81)="" W X,!
  1. W !,?2,"DFN",?15,"Reason for Deletion",!
  1. S $P(X,"-",81)="" W X,!
  1. Q