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

DG53558.m

Go to the documentation of this file. 
  1. DG53558 ;ALB/GN - DG*5.3*558 CLEANUP FOR DUPE MEANS TEST FILE ; 8/15/08 12:27pm
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1.  ;
  1.  ; Read through the Mean Test file (#408.31) via the "C" xref.
  1.  ; Search for duplicate & Bad tests and delete them.  Duplicates are
  1.  ; defined as more than one test for the same patient for the same day
  1.  ; and the same status.  All dupes but the primary test will be
  1.  ; deleted and when no primary test on a given day then the last
  1.  ; transmission for that day will be kept
  1.  ;
  1.  ; Bad tests are defined as those that have a NULL status code in
  1.  ; the 0 node of file 408.31.
  1.  ;
  1.  ; DG*5.3*579 - changes were made to fix a problem when future dated
  1.  ; tests come in and flip a test from Primary to Non-Primary.  This
  1.  ; should not be done for IVM converted cases.  This patch will
  1.  ; find those IVM tests and flip them back to Priamry and flip the
  1.  ; future test that caused this back to Non-Primary.
  1.  Q
  1. TEST ; Entry point for testing this routine
  1.  S TESTING=1
  1. EN ;  Entry point for purging Duplicate Means Tests
  1.  ;
  1.  N QUIT,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTQUEUED,ZTSAVE,CHKPNT
  1.  S CHKPNT=5
  1.  W !,"Do you want to process a group of "_CHKPNT_" duplicates and stop? "
  1.  K DIR
  1.  S DIR("?",1)="  Enter Y to process at least "_CHKPNT_" dupes and stop the utility.  This will "
  1.  S DIR("?",2)="  allow you to verify the cleanup in small steps.  Enter N to process the "
  1.  S DIR("?")="  remainder of the file to completion."
  1.  S DIR(0)="Y" D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) W !,"Cancelled...",! Q
  1.  ;
  1.  S:'Y CHKPNT=0                               ;do not use check points
  1.  ;
  1.  ; setup TM variables and Load 
  1.  S ZTRTN=$S($G(TESTING):"QUET^DG53558",1:"QUE^DG53558")
  1.  S ZTDESC="Cleanup Duplicates in the Means Test file"
  1.  S ZTIO=""
  1.  S ZTSAVE("CHKPNT")=""
  1.  ;
  1.  W !!,ZTDESC,!
  1.  ;check if already running or completed.
  1.  S QUIT=$$CHKSTAT(0)
  1.  Q:QUIT
  1.  D ^%ZTLOAD
  1.  L -^XTMP($$NAMSPC)
  1.  I $D(ZTSK) D
  1.  . W !,"This request queued as Task # ",ZTSK,!
  1.  Q
  1.  ;
  1. POST ;
  1.  N ZTDTH,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTQUEUED,ZTSAVE,CHKPNT
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("=====================================================")
  1.  D MES^XPDUTL("Queuing Dupe Income Test Purge Utility.....")
  1.  I $$CHKSTAT(1) D  Q
  1.  . D BMES^XPDUTL("ABORTING  Post Install Utility Queuing")
  1.  . D MES^XPDUTL("=====================================================")
  1.  S ZTRTN="QUE^DG53558"
  1.  S ZTDESC="Cleanup Duplicates in the Means Test file"
  1.  S ZTIO="",ZTDTH=$H
  1.  S CHKPNT=0,ZTSAVE("CHKPNT")=""
  1.  D ^%ZTLOAD
  1.  L -^XTMP($$NAMSPC)
  1.  D MES^XPDUTL("This request queued as Task # "_ZTSK)
  1.  D MES^XPDUTL("=====================================================")
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. QUET ; Entry point for taskman (testing mode)
  1.  S TESTING=1
  1. QUE ; Entry point for taskman (live mode)
  1.  N NAMSPC S NAMSPC=$$NAMSPC^DG53558
  1.  L +^XTMP(NAMSPC):10 I '$T D  Q   ;quit if can't get a lock
  1.  . S $P(^XTMP(NAMSPC,0,0),U,5)="NO LOCK GAINED"
  1.  N QQ,ZTSTOP,XREC,MTIEN,DIK,DA,IVMTOT,IVMPUR,BEGTIME,PURGDT,IVMBAD
  1.  N DFN,TMP,ICDT,MTST,IVMDUPE,COUNT,PRI,TYPE,TYPNAM,DELETED,IVMIEN,PRIM
  1.  N SRCE,TMPIVM,XX,IVMCV,MAX,IVMIEND,IVMPFL,LINK,LTYP,LTNAM,MTVER
  1.  S TESTING=+$G(TESTING)
  1.  ;
  1.  ;get last run info if exists
  1.  S XREC=$G(^XTMP(NAMSPC,0,0))
  1.  S DFN=$P(XREC,U,1)         ;last REC processed
  1.  S IVMTOT=+$P(XREC,U,2)          ;total records processed
  1.  S IVMPUR=+$P(XREC,U,3)          ;total dupe records purged
  1.  S IVMBAD=+$P(XREC,U,7)          ;total bad records purged
  1.  S IVMPFL=+$P(XREC,U,8)          ;total PRIM records fliped
  1.  S IVMDUPE=IVMPUR
  1.  ;
  1.  ;setup XTMP according to stds. & for 60 day expiration
  1.  D SETUPX^DG53558M(60)
  1.  ;
  1.  ;init status field and start date & time if null
  1.  S $P(^XTMP(NAMSPC,0,0),U,5,6)="RUNNING^"
  1.  S:$P(^XTMP(NAMSPC,0,0),U,4)="" $P(^XTMP(NAMSPC,0,0),U,4)=$$NOW^XLFDT
  1.  ;
  1.  ;drive through "C" XREF level of  MT  file
  1.  S ZTSTOP=0,DELETED=0
  1.  F QQ=1:1 S DFN=$O(^DGMT(408.31,"C",DFN)) Q:'DFN  D  Q:ZTSTOP
  1.  . I $G(CHKPNT)>1,IVMPUR>IVMDUPE,IVMPUR-CHKPNT>IVMDUPE S ZTSTOP=1 Q
  1.  . K TMP,TMPIVM
  1.  . S IVMTOT=IVMTOT+1
  1.  . ;
  1.  . ;build local TMP and prioritize dupes
  1.  . S MTIEN=0
  1.  . F  S MTIEN=$O(^DGMT(408.31,"C",DFN,MTIEN)) Q:'MTIEN  D
  1.  . . I '$D(^DGMT(408.31,MTIEN,0)) K ^DGMT(408.31,"C",DFN,MTIEN) Q
  1.  . . S ICDT=$P(^DGMT(408.31,MTIEN,0),"^",1)
  1.  . . S MTST=$P(^DGMT(408.31,MTIEN,0),"^",3)
  1.  . . S PRI=+$G(^DGMT(408.31,MTIEN,"PRIM"))
  1.  . . S SRCE=+$P(^DGMT(408.31,MTIEN,0),"^",23)
  1.  . . S MTVER=+$P($G(^DGMT(408.31,MTIEN,2)),"^",11)
  1.  . . S MAX=0
  1.  . . S:$D(^DGMT(408.31,MTIEN,"C")) MAX=$O(^DGMT(408.31,MTIEN,"C",""),-1)
  1.  . . S IVMCV=0               ;init IVM converted flag to no DG*5.3*579
  1.  . . F XX=1:1:MAX D  Q:IVMCV
  1.  . . . S:^DGMT(408.31,MTIEN,"C",XX,0)["Z06 MT via Edb" IVMCV=1
  1.  . . I SRCE=2,IVMCV D                     ;IVM converted test from EDB
  1.  . . . S TMPIVM(DFN,ICDT,MTST)=MTIEN,TMPIVM(DFN,ICDT)=MTIEN
  1.  . . . S PRI=1                            ;set as PRIMARY
  1.  . . ;
  1.  . . ;test for null MT status & flag as BAD and delete
  1.  . . I MTST="" D  Q
  1.  . . . S TYPE=$P($G(^DGMT(408.31,MTIEN,0)),"^",19),TYPNAM=""
  1.  . . . S:TYPE]"" TYPNAM=$G(^DG(408.33,TYPE,0))
  1.  . . . D DELBAD(MTIEN,DFN,.IVMBAD,.DELETED)
  1.  . . . Q:'DELETED
  1.  . . . S ^XTMP(NAMSPC,DFN,ICDT,MTVER,999999,MTIEN,"BAD")=TYPE
  1.  . . . S ^XTMP(NAMSPC_".DET",DFN,ICDT,MTVER,MTIEN,"BAD")=TYPNAM
  1.  . . . S $P(^XTMP(NAMSPC,0,0),U,7)=IVMBAD
  1.  . . ;
  1.  . . S COUNT=+$G(TMP(DFN,ICDT,MTST))+1
  1.  . . S TMP(DFN,ICDT,MTVER,MTST)=COUNT
  1.  . . S TMP(DFN,ICDT,MTVER,MTST,MTIEN)=PRI
  1.  . . S:PRI TMP(DFN,ICDT,MTVER,MTST,"P")=MTIEN
  1.  . ;
  1.  . D CLNDUPS^DG53558N(DFN)
  1.  . ;update last processed info
  1.  . S $P(^XTMP(NAMSPC,0,0),U,1,3)=DFN_U_IVMTOT_U_IVMPUR
  1.  . S $P(^XTMP(NAMSPC,0,0),U,7,8)=IVMBAD_U_IVMPFL
  1.  . ;
  1.  . ;check for stop request after every 100 processed DFN recs
  1.  . I QQ#100=0 D
  1.  . . S:$$S^%ZTLOAD ZTSTOP=1
  1.  . . I $D(^XTMP(NAMSPC,0,"STOP")) S ZTSTOP=1 K ^XTMP(NAMSPC,0,"STOP")
  1.  ;
  1.  ;set status and mail stats
  1.  I ZTSTOP S $P(^XTMP(NAMSPC,0,0),U,5,6)="STOPPED"_U_$$NOW^XLFDT
  1.  E  S $P(^XTMP(NAMSPC,0,0),U,5,6)="COMPLETED"_U_$$NOW^XLFDT
  1.  D MAIL^DG53558M
  1.  K TESTING
  1.  L -^XTMP($$NAMSPC)
  1.  Q
  1.  ;
  1.  ;DG*5.3*579 released SETPRIM and 688 moved it to DG53558M
  1.  ;
  1. DELBAD(IEN,DFN,PUR,DELETED) ; Kill Bad test
  1.  S DELETED=0
  1.  Q:'$G(IEN)
  1.  S TESTING=+$G(TESTING,1),DFN=$G(DFN)
  1.  I 'TESTING S DELETED=$$DEL^DG53558M(IEN,.LINK,DFN)
  1.  S:TESTING DELETED=1
  1.  Q:'DELETED
  1.  S IVMBAD=IVMBAD+1
  1.  I '$D(ZTQUEUED) W !,"Deleting BAD IEN in 408.31 > ",IEN," for DFN > ",DFN
  1.  Q
  1.  ;
  1. CHKSTAT(POST) ;check if job is running, stopped, or completed
  1.  N Y,DUOUT,DTOUT,QUIT,STAT,STIME,NAMSPC
  1.  S QUIT=0
  1.  S NAMSPC=$$NAMSPC
  1.  L +^XTMP(NAMSPC):1
  1.  I '$T D BMES^XPDUTL("*** ALREADY RUNNING ***") Q 1
  1.  ;
  1.  ; get job status
  1.  S STAT=$P($G(^XTMP(NAMSPC,0,0)),U,5)
  1.  S STIME=$P($G(^XTMP(NAMSPC,0,0)),U,6)
  1.  ;
  1.  I POST D KILIT Q 0                                     ;DG*5.3*579
  1.  ;
  1.  ;if job Completed and run from menu opt, ask to Re-Run
  1.  I STAT="COMPLETED" D
  1.  . W " was Completed on "_$$FMTE^XLFDT(STIME)
  1.  . W !,"  Do you want to Re-Run again?"
  1.  . K DIR
  1.  . S DIR("?",1)="  Entering Y, will delete the XTMP global where the previous cleanup"
  1.  . S DIR("?")="  information was stored and begin a new job, or N to cancel request"
  1.  . S DIR(0)="Y" D ^DIR
  1.  . I 'Y S QUIT=1 Q
  1.  . W !," ARE YOU SURE?"
  1.  . K DIR
  1.  . S DIR("?")="Enter Y to begin a new Job or N to cancel request"
  1.  . S DIR(0)="Y" D ^DIR
  1.  . I 'Y S QUIT=1 Q
  1.  . ;fall thru to re-run mode, kill ^XTMPs
  1.  . D KILIT
  1.  Q QUIT
  1.  ;
  1. KILIT ; kill Xtmp work files for a re-run
  1.  S:'$D(NAMSPC) NAMSPC=$$NAMSPC^DG53558
  1.  K ^XTMP(NAMSPC),^XTMP(NAMSPC_".DET")
  1.  Q
  1.  ;
  1. STOP ; alternate stop method
  1.  S ^XTMP($$NAMSPC,0,"STOP")=""
  1.  Q
  1.  ;
  1. NAMSPC() ; Return a consistent name space variable
  1.  Q "DG53558"