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

DG53618.m

Go to the documentation of this file. 
  1. DG53618 ;ALB/GN/PHH,EG - DG*5.3*618 CLEANUP DANGLING RECS; 04/27/2005
  1.  ;;5.3;Registration;**618,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ; Cleans up dangling file Income Relation file #408.12 records where
  1.  ; it points to bad or non-existent Income Person file #408.13 and
  1.  ; Patient file #2 records.
  1.  ;
  1.  ; 1. If it points to file 2, that doesn't exist or has a bad 0 node,
  1.  ;     delete the 408.12 rec that points to the bad 2 rec, then
  1.  ;     delete the 408.21 that points to 408.12 rec, then
  1.  ;     delete the 408.22 rec that points to the 408.21.
  1.  ; 2. Same logic will be used if points to bad 408.13 recs
  1.  ;
  1.  Q
  1.  ;
  1. POST ;post install entry tag call.  processes entire file in live mode
  1.  N ZTDTH,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTQUEUED,ZTSAVE,CHKPNT
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("=====================================================")
  1.  D MES^XPDUTL("Queuing Bad Patient Relation Pointers cleanup process.....")
  1.  I $$CHKSTAT(1) D  Q
  1.  . D BMES^XPDUTL("ABORTING  Post Install Cleanup Queuing")
  1.  . D MES^XPDUTL("=====================================================")
  1.  . Q
  1.  S ZTRTN="QUE^DG53618"
  1.  S ZTDESC="Cleanup Bad Pointers In Patient Relation File"
  1.  S ZTIO="",ZTDTH=$H
  1.  S CHKPNT=0,ZTSAVE("CHKPNT")=""
  1.  D ^%ZTLOAD
  1.  D MES^XPDUTL("This request queued as Task # "_ZTSK)
  1.  D MES^XPDUTL("=====================================================")
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. TEST ; Entry point for taskman (testing mode)
  1.  N TESTING,ZTQUEUED
  1.  S TESTING=1,ZTQUEUED=0
  1.  ;if running again, check to see if complete
  1.  ;if so, ask user to rerun
  1.  I $$CHKSTAT(0) D  Q
  1.  . U 0 W !,"Task is already running or user opted to not restart"
  1.  . Q
  1.  D QUE
  1.  Q
  1. QUE ; Entry point for taskman (live mode)
  1.  N NAMSPC S NAMSPC=$$NAMSPC^DG53618
  1.  N QQ,ZTSTOP,XREC,MTIEN,DIK,DA,DGTOT,DGDEL12,BEGTIME,PURGDT,DGDEL21
  1.  N TMP,ICDT,COUNT,TYPE,TYPNAM,DGDEL22,REC12,REC21,REC22
  1.  N DGBAD03,DGBADPAT,DGBADPER
  1.  N R12,PT,DFN,X,U
  1.  S U="^"
  1.  I '$D(TESTING) N TESTING S TESTING=0
  1.  I '$D(ZTQUEUED) N ZTQUEUED S ZTQUEUED=1
  1.  ;
  1.  ;get last run info if exists
  1.  S XREC=$G(^XTMP(NAMSPC,0,0))
  1.  S R12=+$P(XREC,U,1)              ;last REC processed
  1.  S DGTOT=+$P(XREC,U,2)            ;total records processed
  1.  S DGDEL12=+$P(XREC,U,3)          ;total bad 408.12 records purged
  1.  S DGDEL21=+$P(XREC,U,7)          ;total bad 408.21 records found
  1.  S DGDEL22=+$P(XREC,U,8)          ;total bad 408.22 records found
  1.  S DGBADPAT=+$P(XREC,U,9)         ;total bad pointer to file #2
  1.  S DGBADPER=+$P(XREC,U,10)        ;total bad pointer to file #408.13
  1.  S DGBAD03=+$P(XREC,U,11)         ;null or bad field # 03
  1.  ;
  1.  ;setup XTMP according to stds.
  1.  D SETUPX(90)
  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 408.12 looking for bad variable pointers
  1.  S ZTSTOP=0
  1.  F QQ=1:1 S R12=$O(^DGPR(408.12,R12)) Q:(R12'>0)!ZTSTOP  D
  1.  . ;check for stop request after every 20 processed DFN recs
  1.  . I QQ#20=0 D
  1.  . . S:$$S^%ZTLOAD ZTSTOP=1
  1.  . . I $D(^XTMP(NAMSPC,0,"STOP")) S ZTSTOP=1 K ^XTMP(NAMSPC,0,"STOP")
  1.  . . Q
  1.  . I ZTSTOP Q
  1.  . S DGTOT=DGTOT+1
  1.  . S $P(^XTMP(NAMSPC,0,0),U,1,2)=R12_U_DGTOT
  1.  . ;
  1.  . S DFN=$$GET1^DIQ(408.12,R12_",",.01,"I")
  1.  . S PT=$$GET1^DIQ(408.12,R12_",",.03,"I")
  1.  . ;
  1.  . ;good patient (#.01),good variable pointer (#.03)...quit
  1.  . I $$GOODPAT(DFN)="Y",$$GOODPTR(PT)="Y" Q
  1.  . ;
  1.  . ; cleanup Income Relation file #408.12 & the bad pointed to file
  1.  . ; either Patient file #2 or Income Person file #408.13
  1.  . I 'ZTQUEUED W !!,"File #408.12, ien ",R12," has a bad pointer to "
  1.  . ;if patient (#.01) is null
  1.  . I DFN="" D
  1.  . . S X="null patient (field #.01)"
  1.  . . I 'ZTQUEUED W X
  1.  . . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",1)=X
  1.  . . S DGBADPAT=DGBADPAT+1
  1.  . . D ACHK03(R12,PT,ZTQUEUED,TESTING,.DGBADPAT,.DGBADPER,.DGBAD03)
  1.  . . Q
  1.  . ;patient #.01 not found
  1.  . I DFN'="",$$GOODPAT(DFN)="N" D
  1.  . . S X="patient "_DFN_" (field #.01)"
  1.  . . I 'ZTQUEUED W X
  1.  . . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",1)=X
  1.  . . S DGBADPAT=DGBADPAT+1
  1.  . . ;I 'TESTING S DA=DFN,DIK="^DPT(" D ^DIK
  1.  . . D ACHK03(R12,PT,ZTQUEUED,TESTING,.DGBADPAT,.DGBADPER,.DGBAD03)
  1.  . . Q
  1.  . ;patient (#.03) is also a patient, is bad, but patient (# .01) is ok
  1.  . I $$GOODPAT(DFN)="Y",PT["DPT",$$GOODPTR(PT)="N" D
  1.  . . S X="patient "_$P(PT,";",1)_" (field #.03)"
  1.  . . I 'ZTQUEUED W X
  1.  . . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",1)=X
  1.  . . S DGBADPAT=DGBADPAT+1
  1.  . . ;I 'TESTING S DA=$P(PT,";",1),DIK="^DPT(" D ^DIK
  1.  . . Q
  1.  . ;patient (#.01) is good, but income person is bad
  1.  . I $$GOODPAT(DFN)="Y",PT["DGPR",$$GOODPTR(PT)="N" D
  1.  . . S X="income person "_$P(PT,";",1)_" (field #.03)"
  1.  . . I 'ZTQUEUED W X
  1.  . . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",1)=X
  1.  . . S DGBADPER=DGBADPER+1
  1.  . . I 'TESTING S DA=$P(PT,";",1),DIK="^DGPR(408.13," D ^DIK
  1.  . . Q
  1.  . ;patient #.01 is good, but #.03 is null
  1.  . I $$GOODPAT(DFN)="Y",PT="" D
  1.  . . S X="null field #.03"
  1.  . . I 'ZTQUEUED W X
  1.  . . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",1)=X
  1.  . . S DGBAD03=DGBAD03+1
  1.  . . Q
  1.  . ;patient #.01 is good, but #.03 is not null
  1.  . ;and is bad
  1.  . I $$GOODPAT(DFN)="Y",PT'["DGPR",PT'["DPT",PT'="",$$GOODPTR(PT)="N" D
  1.  . . S X="variable pointer "_$P(PT,";",1)_" (field #.03)"
  1.  . . I 'ZTQUEUED W X
  1.  . . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",1)=X
  1.  . . S DGBAD03=DGBAD03+1
  1.  . . Q
  1.  . D DEL40812(R12,.DGDEL12,.DGDEL21,.DGDEL22,ZTQUEUED,TESTING,NAMSPC)
  1.  . Q
  1.  ;
  1.  ;update last processed info
  1.  S X=$G(^XTMP(NAMSPC,0,0))
  1.  S $P(X,U,3)=DGDEL12,$P(X,U,7)=DGDEL21
  1.  S $P(X,U,8)=DGDEL22,$P(X,U,9)=DGBADPAT
  1.  S $P(X,U,10)=DGBADPER,$P(X,U,11)=DGBAD03
  1.  S ^XTMP(NAMSPC,0,0)=X
  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.  S X=$$MAIL^DG53618M(TESTING)
  1.  K TESTING
  1.  L -^XTMP($$NAMSPC)
  1.  Q
  1.  ;
  1. GOODPAT(DFN) ;determine if patient is there
  1.  N X,U
  1.  S U="^"
  1.  I DFN="" Q "N"
  1.  I '$D(^DPT(DFN,0)) Q "N"
  1.  S X=$G(^DPT(DFN,0)) I X="" Q "N"
  1.  I X?13"^".E Q "N"
  1.  Q "Y"
  1.  ;
  1. GOODPTR(PT) ;determine if reference is there
  1.  N X,U,SUB,GL,REF
  1.  S U="^"
  1.  I PT'["DPT",PT'["DGPR" Q "N"
  1.  S SUB=$P(PT,";",1),GL=$P(PT,";",2)
  1.  I SUB="" Q "N"
  1.  I SUB'=+SUB S SUB=$C(34)_SUB_$C(34)
  1.  I GL'="DPT(",GL'="DGPR(408.13," Q "N"
  1.  S REF="^"_GL_SUB_",0)"
  1.  S X=$G(@REF)
  1.  I '$D(@REF) Q "N"
  1.  I $G(GL)["DPT",X?13"^".E Q "N"
  1.  I $G(GL)["DGPR",$P(X,U,1)="" Q "N"
  1.  Q "Y"
  1.  ;
  1.  ;at this point, you have a bad .01 field, but want
  1.  ;to check .03 also
  1. ACHK03(R12,PT,ZTQUEUED,TESTING,DGBADPAT,DGBADPER,DGBAD03) ;
  1.  ;update counters to include bad variable pointers
  1.  ;bad pointer to patient
  1.  I PT["DPT",$$GOODPTR(PT)="N" D  Q
  1.  . S DGBADPAT=DGBADPAT+1
  1.  . S X="and bad patient pointer "_$P(PT,";",1)_" (field #.03)"
  1.  . I 'ZTQUEUED W !,"     ",X
  1.  . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",2)=X
  1.  . ;I 'TESTING S DA=$P(PT,";",1),DIK="^DPT(" D ^DIK
  1.  . Q
  1.  ;bad pointer to income person
  1.  I PT["DGPR",$$GOODPTR(PT)="N" D  Q
  1.  . S DGBADPER=DGBADPER+1
  1.  . S X="and bad income person pointer "_$P(PT,";",1)_" (field #.03)"
  1.  . I 'ZTQUEUED W !,"    ",X
  1.  . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",2)=X
  1.  . I 'TESTING S DA=$P(PT,";",1),DIK="^DGPR(408.13," D ^DIK
  1.  . Q
  1.  ;null variable pointer
  1.  I PT="" D  Q
  1.  . S X="and null pointer (field #.03)"
  1.  . I 'ZTQUEUED W !,"     ",X
  1.  . S DGBAD03=DGBAD03+1
  1.  . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",2)=X
  1.  . Q
  1.  ;bad variable pointer
  1.  I $$GOODPTR(PT)="N" D
  1.  . S X="and bad variable pointer "_$P(PT,";",1)_" (field #.03)"
  1.  . I 'ZTQUEUED W !,"     ",X
  1.  . S DGBAD03=DGBAD03+1
  1.  . S ^XTMP(NAMSPC,"BADPR",R12,"ERR",2)=X
  1.  . Q
  1.  Q
  1.  ;
  1. DEL40812(R12,DGDEL12,DGDEL21,DGDEL22,ZTQUEUED,TESTING,NAMSPC) ;
  1.  ; Kill bad #408.12 file rec and files that point to it
  1.  N DA,DIK,R21,R22,X
  1.  S DA=R12,DIK="^DGPR(408.12," D ^DIK:'TESTING
  1.  S DGDEL12=DGDEL12+1
  1.  I 'ZTQUEUED W !,?2,"Deleting 408.12 ien > ",R12
  1.  ;
  1.  ;kill all 408.21's that point to the bad 408.12
  1.  S R21=0
  1.  F  S R21=$O(^DGMT(408.21,"C",R12,R21)) Q:'R21  D
  1.  . I 'TESTING S DA=R21,DIK="^DGMT(408.21," D ^DIK
  1.  . S DGDEL21=DGDEL21+1
  1.  . S X="Deleting related ien "_R21_" in file #408.21"
  1.  . I 'ZTQUEUED W !,?4,X
  1.  . S ^XTMP(NAMSPC,"BADPR",R12,"REL",R21)=X
  1.  . ;
  1.  . ;kill all 408.22's that point to the bad 408.21
  1.  . S R22=0
  1.  . F  S R22=$O(^DGMT(408.22,"AIND",R21,R22)) Q:'R22  D
  1.  . . I 'TESTING S DA=R22,DIK="^DGMT(408.22," D ^DIK
  1.  . . S DGDEL22=DGDEL22+1
  1.  . . S X="Deleting related ien "_R22_" in file # 408.22"
  1.  . . I 'ZTQUEUED W !,?6,X
  1.  . . S ^XTMP(NAMSPC,"BADPR",R12,"REL",R21,R22)=X
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. CHKSTAT(POST) ;
  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
  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 theprevious 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
  1.  Q QUIT
  1.  ;
  1. KILIT ; kill Xtmp work file for a re-run
  1.  S:'$D(NAMSPC) NAMSPC=$$NAMSPC^DG53618
  1.  K ^XTMP(NAMSPC)
  1.  Q
  1.  ;
  1. STOP ; alternate stop method
  1.  S ^XTMP($$NAMSPC,0,"STOP")=""
  1.  Q
  1.  ;
  1. SETUPX(EXPDAY) ;Setup XTMP
  1.  N BEGTIME,PURGDT,NAMSPC,U
  1.  S U="^"
  1.  S NAMSPC=$$NAMSPC^DG53618
  1.  S BEGTIME=$$NOW^XLFDT()
  1.  S PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAY)
  1.  S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
  1.  S $P(^XTMP(NAMSPC,0),U,3)="Cleanup Bad Pointers In PATIENT RELATION File"
  1.  Q
  1.  ;
  1. NAMSPC() ; Return a consistent name space variable
  1.  Q $T(+0)