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

DG53426.m

Go to the documentation of this file. 
  1. DG53426 ;ALB/AEG - DG*5.3*426 POST-INSTALLATION ;2-13-02
  1.  ;;5.3;Registration;**426**;2-13-02
  1.  ;
  1.  ; The cleanup consists of 2 issues, they are as follows:
  1.  ; 1.  The patient file will be searched for patients that are not
  1.  ;     expired and have a means test status of required. If the tests
  1.  ;     are after 10/5/99, all of the patient's primary tests on record
  1.  ;     will be evaluated to determine if they would have met the 
  1.  ;     criteria outlined in patch DG*5.3*326 had the functionality been
  1.  ;     in place at the time the REQUIRED status test was "stubbed" in 
  1.  ;     the system.  If this is found to be the case, the 'REQUIRED' 
  1.  ;     tests will be purged from the system and the veteran will revert
  1.  ;     to the Category C, Agreed to Pay status.
  1.  ; 2.  The next issue to be evaluated during the search is those 
  1.  ;     those patients who declined to provide income information but
  1.  ;     did Agree to Pay the deductible if they have a 'REQUIRED' status
  1.  ;      test on file.  If they meet these criteria, regardless of the 
  1.  ;     10/5/99 restriction from #1, the 'REQUIRED' status tests will be 
  1.  ;     purged from the system and the veteran will revert to the
  1.  ;     the previous Category C, Agreed to Pay status.  A 
  1.  ;     change of functionality will be required in order to preclude
  1.  ;     system from re-stubbing 'REQUIRED' status records. 
  1.  ;
  1. EN ; MAIN ENTRY POINT
  1.  D INIT
  1.  Q
  1. INIT ; Initialize tracking globals and associated checkpoints.
  1.  K ^TMP($J),^XTMP("DG-DFN"),^XTMP("DG-REQIEN")
  1.  N %,I,X,X1,X2
  1.  ; Create Checkpoints
  1.  I $D(XPDNM) D
  1.  .I $$VERCP^XPDUTL("DFN")'>0 D
  1.  ..S %=$$NEWCP^XPDUTL("DFN","",0)
  1.  .I $$VERCP^XPDUTL("REQIEN")'>0 D
  1.  ..S %=$$NEWCP^XPDUTL("REQIEN","",0)
  1.  ;
  1.  ; init tracking globals
  1.  F I="DFN","REQIEN" D
  1.  .I $D(^XTMP("DG-"_I)) Q
  1.  .S X1=DT,X2=30 D C^%DTC
  1.  .S ^XTMP("DG-"_I,0)=X_U_$$DT^XLFDT_"^DG*5.3*426 POST INSTALL "
  1.  .S ^XTMP("DG-"_I,0)=^XTMP("DG-"_I,0)_$S(I="DFN":"Records Matching Search Criteria",I="REQIEN":"Required status tests purged",1:"errors")
  1.  I '$D(XPDNM) S (^XTMP("DG-DFN",1),^XTMP("DG-REQIEN",1))=0
  1.  ;
  1.  ; Check status and if root checkpoint has not completed start the
  1.  ; cleanup.
  1.  I $D(XPDNM) S %=$$VERCP^XPDUTL("DFN")  D
  1.  .I '$D(^XTMP("DG-DFN",1)) S ^XTMP("DG-DFN",1)=0
  1.  .I '$D(^XTMP("DG-REQIEN",1)) S ^XTMP("DG-REQIEN",1)=0
  1.  I $G(%)="" S %=0
  1.  I %=0 D EN1
  1.  Q
  1. EN1 ; control the logic from this point.
  1.  D PSI
  1.  I '$D(^TMP($J,"MTD")) D BMES^XPDUTL("No data found requiring cleanup.  Installation completed on"),MES^XPDUTL($$FMTE^XLFDT($$NOW^XLFDT)) Q
  1.  D PSII,CAT1A,CAT1B
  1.  D CAT2,CAT3,CAT4
  1.  Q
  1. PSI ; MAIN SEARCH ENGINE
  1.  D BMES^XPDUTL("POST INSTALLATION PROCESSING")
  1.  D MES^XPDUTL("----------------------------")
  1.  D BMES^XPDUTL("Phase I - Search engine started on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  D BMES^XPDUTL("Each '.' represents 200 records reviewed ...")
  1.  N DFN,MTIEN,DGMTDT,DGCNT,DGDOA
  1.  S (DFN,MTIEN,DGMTDT)=""
  1.  S DFN=0 F DGCNT=1:1 S DFN=$O(^DPT(DFN)) Q:'+DFN  D
  1.  .I '$D(ZTQUEUED) W:'(DGCNT#200) "."
  1.  .S DGDOA=$P($G(^DPT(DFN,.35)),U)
  1.  .; Don't look at records of deceased patients.
  1.  .D:'+DGDOA
  1.  ..N DGMTSTAT,DGMTLST
  1.  ..S DGMTLST=$$LST^DGMTU(DFN,"",1),DGMTSTAT=$P($G(DGMTLST),U,4)
  1.  ..; Only look at those patients whose latest primary test is in
  1.  ..; a required status.
  1.  ..I $G(DGMTSTAT)="R" D
  1.  ...; Check Last valid test to make sure it is not Cat A or NLR
  1.  ...N DGMTLVT,DGMTLVTS
  1.  ...S DGMTLVT=$$LVMT^DGMTU(DFN),DGMTLVTS=$P($G(DGMTLVT),U,4)
  1.  ...Q:((DGMTLVTS="N")!(DGMTLVTS="A"))
  1.  ...; call API to setup a tmp global of a given patient's primary tests.
  1.  ...; only if the test is Cat C or Pending Adj.
  1.  ...D MTDA^DG53426U(DFN)
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  D BMES^XPDUTL("Phase I search completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  Q
  1. PSII ; Phase II - Process data from Phase I search.  Parse the data
  1.  ; according to which group it belongs to, the groups are:
  1.  ;
  1.  ; 1. Cat C or Pend. Adj./Agreed to Pay/Income info provided/ 
  1.  ;    after 10/5/99
  1.  ; 2. Cat C or Pend. Adj./ Declined to provide income info but did
  1.  ;    agree to pay deductible.
  1.  ; 3. Cat C or Pending Adj / Declined to provide income info & did
  1.  ;    NOT provide income info. (Ineligible)
  1.  ; 4. Cat C or Pending adj. / Provided income info but did NOT
  1.  ;    AGREE to pay deductible.
  1.  I $D(^TMP($J,"MTD")) D
  1.  .D BMES^XPDUTL("Phase II - Parsing data ...")
  1.  .N DFN,DGCNT,DGMTI,CAT
  1.  .S (DFN,DGMTI)=""
  1.  .F DGCNT=1:1 S DFN=$O(^TMP($J,"MTD",DFN)) Q:'DFN  D
  1.  ..I '$D(ZTQUEUED) W:'(DGCNT#200) "."
  1.  ..S DGMTI=+$G(^TMP($J,"MTD",DFN)),CAT=$$AGTP^DG53426U(DGMTI)
  1.  ..S ^TMP($J,"CAT "_CAT,DFN)=$G(^TMP($J,"MTD",DFN))
  1.  ..S ^XTMP("DG-DFN",1)=$G(^XTMP("DG-DFN",1))+1
  1.  ..I $D(XPDNM) S %=$$UPCP^XPDUTL("DFN",+DFN)
  1.  ..K ^TMP($J,"MTD",DFN)
  1.  ..Q
  1.  .D BMES^XPDUTL("Phase II completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  .Q
  1.  Q
  1. CAT1A ; This tag will process those veterans who are in Category 1
  1.  ; - Subcategory 1a - Vets who are in a REQUIRED status but have
  1.  ;                    a previous test after 10/5/99 of Cat C or 
  1.  ;                    pending Adjudication & have agreed to Pay.
  1.  ;                    REQUIRED test will be purged (Event driver is
  1.  ;                    invoked).
  1.  ; - Subcategory 1b - Vets who are in a REQUIRED status but have
  1.  ;                    a previous test before 10/6/99 or Cat C or
  1.  ;                    Pending Adjudication & have agreed to pay.
  1.  ;                    (No action taken on these folks other than to
  1.  ;                    report them to site for further action -- remain
  1.  ;                    in a REQUIRED status.)
  1.  D BMES^XPDUTL("Phase III processing began on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  I '$D(^TMP($J,"CAT 1a")) D
  1.  .D CAT1A^DG53426M
  1.  .D BMES^XPDUTL("Phase III processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  .Q
  1.  I $D(^TMP($J,"CAT 1a")) D
  1.  .N DFN,DGCDAT,DGMTDT,IEN
  1.  .S DFN="" F  S DFN=$O(^TMP($J,"CAT 1a",DFN)) Q:'DFN  D
  1.  ..S DGCDAT=$P($P($G(^TMP($J,"CAT 1a",DFN)),"~~",2),U,1)
  1.  ..S DGMTDT="" F  S DGMTDT=$O(^DGMT(408.31,"AD",1,DFN,DGMTDT)) Q:'DGMTDT  I DGMTDT>DGCDAT D
  1.  ...S IEN="" F  S IEN=$O(^DGMT(408.31,"AD",1,DFN,DGMTDT,IEN)) Q:'IEN  D
  1.  ....I $G(IEN),$P($G(^DGMT(408.31,IEN,0)),U,3)=1 D
  1.  .....S ^TMP("P-REQ",$J,DFN_"~~"_IEN)=$G(^DGMT(408.31,IEN,0))
  1.  .....I $$EN^DG53426D(IEN)
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I $D(^TMP("P-REQ",$J)) D CAT1AP^DG53426M,BMES^XPDUTL("Phase III processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  Q
  1.  ;
  1. CAT1B ; Process Cat 1b tests - See DG53426U for info on classification.
  1.  D BMES^XPDUTL("Phase IV processing began on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  I '$D(^TMP($J,"CAT 1b")) D
  1.  .D CAT1B^DG53426M
  1.  .D BMES^XPDUTL("Phase IV processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  .Q
  1.  I $D(^TMP($J,"CAT 1b")) D
  1.  .D CAT1BR^DG53426M
  1.  .D BMES^XPDUTL("Phase IV completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  .Q
  1.  Q
  1. CAT2 ; Process Cat 2 vets - See DG53426U for info on classification.
  1.  ;
  1.  D BMES^XPDUTL("Phase V processing began on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  I '$D(^TMP($J,"CAT 2")) D
  1.  .D NOCAT2^DG53426M
  1.  .D BMES^XPDUTL("Phase V processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  .Q
  1.  I $D(^TMP($J,"CAT 2")) D
  1.  .N DFN,DGCDAT,DGMTDT,IEN
  1.  .S DFN="" F  S DFN=$O(^TMP($J,"CAT 2",DFN)) Q:'DFN  D
  1.  ..S DGCDAT=$P($P($G(^TMP($J,"CAT 2",DFN)),"~~",2),U,1)
  1.  ..S DGMTDT="" F  S DGMTDT=$O(^DGMT(408.31,"AD",1,DFN,DGMTDT)) Q:'DGMTDT  I DGMTDT>DGCDAT  D
  1.  ...S IEN="" F  S IEN=$O(^DGMT(408.31,"AD",1,DFN,DGMTDT,IEN)) Q:'IEN  D
  1.  ....I $D(IEN),$P($G(^DGMT(408.31,IEN,0)),U,3)=1 D
  1.  .....S ^TMP("P-REQ",$J,DFN_"~~"_IEN)=$G(^DGMT(408.31,IEN,0))
  1.  .....I $$EN^DG53426D(IEN)
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I $D(^TMP("P-REQ",$J)) D CAT2P^DG53426N,BMES^XPDUTL("Phase V processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  Q
  1. CAT3 ; Process Cat 3 vets - See DG53426U for info on classification.
  1.  ;
  1.  D BMES^XPDUTL("Phase VI processing began on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  I '$D(^TMP($J,"CAT 3")) D
  1.  .D NOCAT3^DG53426N
  1.  .D BMES^XPDUTL("Phase VI processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  .Q
  1.  I $D(^TMP($J,"CAT 3")) D
  1.  .D CAT3^DG53426N
  1.  .D BMES^XPDUTL("Phase VI processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  .Q
  1.  Q
  1. CAT4 ; Process Cat 4 vets - See DG53426U for info on classification.
  1.  ;
  1.  D BMES^XPDUTL("Phase VII processing began on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  I '$D(^TMP($J,"CAT 4")) D
  1.  .D NOCAT4^DG53426N
  1.  .D BMES^XPDUTL("Phase VII processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  .Q
  1.  I $D(^TMP($J,"CAT 4")) D
  1.  .D CAT4^DG53426N
  1.  .D BMES^XPDUTL("Phase VII processing completed on "_$$FMTE^XLFDT($$NOW^XLFDT))
  1.  .Q
  1.  Q