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

DG53661P.m

Go to the documentation of this file. 
  1. DG53661P ; ALB/TK,LBD - DG*5.3*661 POST INSTALL CONVERSION ROUTINE ; 5/18/10 1:11pm
  1.  ;;5.3;Registration;**661**;Aug 13, 1993;Build 5
  1.  ;
  1. EN ; Entry point for post installation routine DG*5.3*661
  1.  N NAMSPC,ZTDESC,ZTDTH,ZTRTN,ZTSK
  1.  S NAMSPC=$$NAMSPC
  1.  S ZTRTN="CTLINKS^DG53661P("""_NAMSPC_""")"
  1.  S ZTDESC="DG*5.3*661 Cleanup Invalid MT/CT Links"
  1.  S ZTIO="",ZTDTH=$$NOW^XLFDT
  1.  D ^%ZTLOAD
  1.  D BMES^XPDUTL("Cleanup Invalid MT/CT Links Process started - task #"_$G(ZTSK))
  1.  Q
  1.  ;
  1.  N CT,CT1,DA,DFN,DIE,DR,IVM,IVMCT,IVMNOW,X,Y,Z
  1.  I '$D(^XTMP(NAMSPC)) D
  1.  . S ^XTMP(NAMSPC,0)=$$FMADD^XLFDT(DT,180)_U_DT_U_"CLEAN UP INVALID MEANS TEST/COPAY TEST LINKS",^XTMP(NAMSPC,"PARAMS")=""
  1.  S Z=$G(^XTMP(NAMSPC,"PARAMS"))
  1.  I $P(Z,U,4)="RUNNING" D  Q
  1.  . S ^XTMP(NAMSPC,"RUNNING",$$NOW^XLFDT)="UPDATE ALREADY RUNNING"
  1.  . D BULL(NAMSPC,,,,"RUNNING")
  1.  I $P(Z,U,4)="DONE" D  Q
  1.  . S ^XTMP(NAMSPC,"RUNNING",$$NOW^XLFDT)="UPDATE ALREADY COMPLETE"
  1.  . D BULL(NAMSPC,,,,"DONE")
  1.  S $P(^XTMP(NAMSPC,"PARAMS"),U,4)="RUNNING"
  1.  S IVMNOW=$$NOW^XLFDT,^XTMP(NAMSPC,"RUNNING",IVMNOW)="",^XTMP(NAMSPC,"RUNNING",IVMNOW,+$G(ZTSK))=""
  1.  S CT=+Z,IVM=+$P(Z,U,2),CT1=+$P(Z,U,3)
  1.  F  S IVM=$O(^DGMT(408.31,IVM)) Q:'IVM  D
  1.  . S IVMCT=$P($G(^DGMT(408.31,IVM,2)),U,6) Q:$$STOP(CT1)  S CT1=CT1+1,$P(^XTMP(NAMSPC,"PARAMS"),U,2,3)=IVM_U_CT1
  1.  . S DFN=+$P($G(^DGMT(408.31,IVM,0)),U,2)
  1.  . I IVMCT D  ; Check for copay test for same income year as means test
  1.  .. ; OK if years match
  1.  .. I $$YR(IVM)=$$YR(IVMCT) Q
  1.  .. ; Delete link to income test in a different income year
  1.  .. S DA=IVM,DIE="^DGMT(408.31,",DR="2.06///@"
  1.  .. D ^DIE
  1.  .. S CT=CT+1,$P(^XTMP(NAMSPC,"PARAMS"),U,1)=CT
  1.  .. S ^XTMP(NAMSPC,"LINK_DELETED",IVM,IVMCT)=""
  1.  S $P(^XTMP(NAMSPC,"PARAMS"),U,4)=$S('$G(ZTSTOP):"DONE",1:"STOPPED"),^XTMP(NAMSPC,"RUNNING",IVMNOW)=$$NOW^XLFDT
  1.  D BULL(NAMSPC,CT,CT1,IVMNOW,'$G(ZTSTOP))
  1.  Q
  1.  ;
  1. BULL(NAMSPC,CHANGED,READ,WHEN,DONE) ; Send bulletin
  1.  N LN,TMP,XMDUZ,XMSUB,XMTEXT,XMY
  1.  S XMY(DUZ)="",XMY("G.DGEN ELIGIBILITY ALERT")="",XMDUZ=.5,XMTEXT="TMP("""_NAMSPC_""","
  1.  ; Set up copay test 'links' deleted bulletin
  1.  S XMSUB=NAMSPC_": COPAY TEST LINK CLEANUP - SUMMARY REPORT"
  1.  S LN=1
  1.  S TMP(NAMSPC,LN)=""
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)="COPAY TEST INVALID LINK UPDATE RESULTS"
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)="--------------------------------------"
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)=""
  1.  I DONE="RUNNING" D  Q
  1.  . S LN=LN+1
  1.  . S TMP(NAMSPC,LN)="Sorry, a copay test link clean up is already running."
  1.  . S LN=LN+1
  1.  . S TMP(NAMSPC,LN)=""
  1.  . D ^XMD
  1.  I DONE="DONE" D  Q
  1.  . S LN=LN+1
  1.  . S TMP(NAMSPC,LN)="Sorry, the copay test link clean up has already completed."
  1.  . S LN=LN+1
  1.  . S TMP(NAMSPC,LN)=""
  1.  . D ^XMD
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)="The cleanup has "_$S(DONE:"run to completion",1:"finished a partial run")_".  Here are the results"_$S(DONE:"",1:" to date")_":"
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)=""
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)="  Start Date/Time: "_$$FMTE^XLFDT(WHEN)
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)="    End Date/Time: "_$$FMTE^XLFDT($G(^XTMP(NAMSPC,"RUNNING",WHEN)))
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)=""
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)="Current Counts: "
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)="  Total File #408.31 Records Processed: "_READ
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)="                 Total Links Corrected: "_CHANGED
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)=""
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)="Cleaned up records are referenced in ^XTMP("""_NAMSPC_""",""LINK_DELETED"" global"
  1.  S LN=LN+1
  1.  S TMP(NAMSPC,LN)=""
  1.  D ^XMD
  1.  Q
  1.  ;
  1. YR(IVM) ; Return year of the means test
  1.  Q $E($P($G(^DGMT(408.31,+IVM,0)),U),1,3)
  1.  ;
  1. STOP(CT1) ; Check if asked to stop
  1.  ; Only check if tasked and every 6000 records read
  1.  Q:$S('$G(ZTSK):1,1:CT1#6000) 0
  1.  N X
  1.  S X=$$S^%ZTLOAD
  1.  I X S ZTSTOP=1
  1.  Q $G(ZTSTOP)
  1.  ;
  1. NAMSPC() ; 
  1.  Q "DG53661"
  1.  ;
  1. CTSTART ; Restart copay test invalid link
  1.  N NAMSPC,ZTDESC,ZTDTH,ZTRTN,ZTSK
  1.  S NAMSPC=$$NAMSPC,$P(^XTMP(NAMSPC,"PARAMS"),U,4)=""
  1.  S ZTRTN="CTLINKS^DG53661P("_NAMSPC_")"
  1.  S ZTDESC="DG*5.3*661 Cleanup Invalid MT/CT Links Process Restart"
  1.  S ZTIO="",ZTDTH=$$NOW^XLFDT
  1.  D ^%ZTLOAD
  1.  W !,"TASK # IS: ",$G(ZTSK)
  1.  Q
  1.  ;