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

BQINIGH3.m

Go to the documentation of this file. 
  1. BQINIGH3 ;GDIT/HS/ALA-Nightly job continued ; 26 Apr 2013  11:07 AM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
  1.  ;
  1. JBC ;EP - Check on MU jobs
  1.  NEW ZTSK,NJOB,YJOB,NXDT
  1.  S NJOB=$P($G(^BQI(90508,1,12)),U,5)
  1.  S YJOB=$P($G(^BQI(90508,1,12)),U,6)
  1.  ;
  1.  ; check on ninety day job
  1.  I NJOB'="" D
  1.  . S ZTSK=NJOB D STAT^%ZTLOAD
  1.  . I $G(ZTSK(2))'="Active: Pending" D
  1.  .. I $G(ZTSK(2))="Active: Running" Q
  1.  .. I $G(ZTSK(2))="Inactive: Finished" S $P(^BQI(90508,1,12),U,5)="" D  Q
  1.  ... D JBD
  1.  ... D NJB
  1.  .. I $G(ZTSK(2))="Inactive: Interrupted"!($G(ZTSK(2))="Undefined") D
  1.  ... I $P($G(^BQI(90508,1,12)),U,3)=0 D JBD,NJB Q
  1.  ... S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
  1.  ... S ZTDESC="MU CQ Continue Compile",ZTRTN="NIN^BQITASK6",ZTIO=""
  1.  ... D ^%ZTLOAD
  1.  ... S BQIUPD(90508,"1,",12.05)=ZTSK
  1.  ... D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  I YJOB'="" D
  1.  . S ZTSK=YJOB D STAT^%ZTLOAD
  1.  . I $G(ZTSK(2))'="Active: Pending" D
  1.  .. I $G(ZTSK(2))="Active: Running" Q
  1.  .. I $G(ZTSK(2))="Inactive: Finished" S $P(^BQI(90508,1,12),U,6)="" D  Q
  1.  ... D JBDY
  1.  ... D NJBY
  1.  .. I $G(ZTSK(2))="Inactive: Interrupted"!($G(ZTSK(2))="Undefined") D
  1.  ... I $P($G(^BQI(90508,1,12)),U,4)=0 D JBDY,NJBY Q
  1.  ... S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
  1.  ... S ZTDESC="MU Performance Continue Monthly Compile",ZTRTN="NIN^BQITASK7",ZTIO=""
  1.  ... D ^%ZTLOAD
  1.  ... S BQIUPD(90508,"1,",12.06)=ZTSK
  1.  ... D FILE^DIE("","BQIUPD","ERROR")
  1.  ; If job does not have a task number, quit
  1.  I NJOB="" D JBD,NJB
  1.  I YJOB="" D JBDY,NJBY
  1.  Q
  1.  ;
  1. JBD ;EP - Job date
  1.  NEW BMDT
  1.  S BMDT=$P(^BQI(90508,1,12),U,9),BMDT=$$FMADD^XLFDT(BMDT,1)
  1.  I $D(^XTMP("BQIMMON",BMDT)) K ^XTMP("BQIMMON",BMDT)
  1.  I $O(^XTMP("BQIMMON",""),-1)="" K ^XTMP("BQIMMON") Q
  1.  Q
  1.  ;
  1. JBDY ;EP
  1.  NEW BMDT
  1.  S BMDT=$P(^BQI(90508,1,9),U,2),BMDT=$$FMADD^XLFDT(BMDT,1)
  1.  I $D(^XTMP("BQIMMONP",BMDT)) K ^XTMP("BQIMMONP",BMDT)
  1.  I $O(^XTMP("BQIMMONP",""),-1)="" K ^XTMP("BQIMMONP") Q
  1.  Q
  1.  ;
  1. NJB ;EP - Next job
  1.  I $P($G(^BQI(90508,1,12)),U,3)=0 D
  1.  . ; Get next date to process
  1.  . S NXDT=$O(^XTMP("BQIMMON",""),-1) I 'NXDT Q
  1.  . D CQ^BQIMUMON(NXDT)
  1.  Q
  1.  ;
  1. NJBY ;EP
  1.  I $P($G(^BQI(90508,1,12)),U,4)=0 D
  1.  . ; Get next date to process
  1.  . S NXDT=$O(^XTMP("BQIMMONP",""),-1) I 'NXDT Q
  1.  . D PF^BQIMUMON(NXDT)
  1.  Q
  1.  ;
  1. IJB(IPDATE) ;EP - IPC Job check
  1.  NEW ZTSK,IJOB
  1.  S IJOB=$P($G(^BQI(90508,1,11)),U,4)
  1.  ; If IPC job is blank set up task
  1.  I IJOB="" D INJ Q
  1.  ;
  1.  ; check on IPC monthly job
  1.  I IJOB'="" D
  1.  . S ZTSK=IJOB D STAT^%ZTLOAD
  1.  . I $G(ZTSK(2))'["Pending" D
  1.  .. I $G(ZTSK(2))["Running" Q
  1.  .. I $G(ZTSK(2))["Finished" S $P(^BQI(90508,1,11),U,4)="" Q
  1.  .. I $G(ZTSK(2))["Undefined" D  Q
  1.  ... I $P($G(^BQI(90508,1,11)),U,3)="",'$D(^%ZTSK(ZTSK)) S $P(^BQI(90508,1,11),U,4)="" Q
  1.  ... I $P($G(^BQI(90508,1,11)),U,3)'="" S IPDATE=$P($G(^BQI(90508,1,11)),U,5) D INJ
  1.  .. I $G(ZTSK(2))["Inactive"!($G(ZTSK(2))["Interrupted") D
  1.  ... S IPDATE=$P($G(^BQI(90508,1,11)),U,5) D INJ
  1.  Q
  1.  ;
  1. INJ ;EP - New IPC job
  1.  NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
  1.  S ZTDESC="IPC Monthly Compile",ZTRTN="EN^BQIIPMNU",ZTIO="",ZTSAVE("BQDATE")=$G(IPDATE)
  1.  D ^%ZTLOAD
  1.  S BQIUPD(90508,"1,",11.04)=ZTSK
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  Q
  1.  ;
  1. POV ;EP - Set up POV table
  1.  NEW DN,CD,NN,CNT
  1.  K ^XTMP("BQIPOV")
  1.  S ^XTMP("BQIPOV",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"POV Table Values"
  1.  S DN=0,II=0
  1.  F  S DN=$O(^AUPNVPOV("B",DN)) Q:DN=""  D
  1.  . I $G(^ICD9(DN,0))="" Q
  1.  . S NN="",CNT=0 F  S NN=$O(^AUPNVPOV("B",DN,NN)) Q:NN=""  D
  1.  .. NEW VIS
  1.  .. S VIS=$P(^AUPNVPOV(NN,0),"^",3) I VIS="" Q
  1.  .. Q:"DXCT"[$P(^AUPNVSIT(VIS,0),U,7)
  1.  .. S CNT=CNT+1
  1.  . S II=II+1,^XTMP("BQIPOV",II)=DN_U_$$VST^ICDCODE(DN,"",80)_U_$$CODEC^ICDCODE(DN,80)_U_CNT
  1.  . S ^XTMP("BQIPOV","Z",CNT,DN)=$$VST^ICDCODE(DN,"",80)_U_$$CODEC^ICDCODE(DN,80)
  1.  Q
  1.  ;
  1. SNO ;EP - Set up SNOMED table
  1.  D SN^BQISNOMS
  1.  Q
  1.  ;
  1. JBB(TYP) ;EP - Job off counts
  1.  NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
  1.  S ZTDESC="Count Compile",ZTRTN=TYP_"^BQINIGH3",ZTIO=""
  1.  D ^%ZTLOAD
  1.  Q
  1.  ;
  1. WK ;EP - Weekly IPC job
  1.  NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
  1.  S ZTDESC="IPC Weekly Compile",ZTRTN="EN^BQIIPWKL",ZTIO=""
  1.  D ^%ZTLOAD
  1.  S BQIUPD(90508,"1,",11.06)=ZTSK
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  Q