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

BQITASK6.m

Go to the documentation of this file. 
  1. BQITASK6 ;GDIT/HS/ALA-MU CQ Job ; 30 Sep 2011  1:06 PM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**1,3,4**;Apr 18, 2012;Build 66
  1.  ;
  1. NIN ;EP -- BQI UPDATE MU CQM monthly
  1.  ;
  1.  I $G(DUZ(2))="" D
  1.  . D DZ^BQITASK1 M DUZ=^XTMP("BQIRMDR","DUZ")
  1.  ;
  1.  NEW DESC,BJOB,BCJOB,BQPROH
  1.  S BQPROH=+$P(^BQI(90508,1,12),U,7)
  1.  S BQIMUDTM=$$NOW^XLFDT(),BQIMUDT=$P(BQIMUDTM,".",1),BQIMUTIM=$P(BQIMUDTM,".",2)
  1.  S CDOW=$$DOW^XLFDT(BQIMUDT,1)
  1.  I CDOW'=6,CDOW'=0,BQPROH,$E(BQIMUTIM,1,2)+3>6,$E(BQIMUTIM,1,2)+3<18 D  Q
  1.  . S ZTDTH=BQIMUDT_".183"
  1.  . S ZTDESC="MU CQ Monthly Compile",ZTRTN="NIN^BQITASK6",ZTIO=""
  1.  . D ^%ZTLOAD
  1.  . S BQIUPD(90508,"1,",12.05)=ZTSK
  1.  . D FILE^DIE("","BQIUPD","ERROR")
  1.  . K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
  1.  ;
  1.  ;   Set the DATE/TIME MU STARTED field
  1.  NEW DA,BQIMUTIM,BQIMUDT,CDOW,BQIMUDTM,STOP
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",4.19)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",4.21)=1
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  K ^XTMP("BQIMUMON")
  1.  S ^XTMP("BQIMUMON",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"Monthly MU Provider List"
  1.  ;
  1.  I $O(^XTMP("BQIMCQMPT",0))="" S ^XTMP("BQICQMPT",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"MU CQ Patients"
  1.  S BGPPROV=$P(^BQI(90508,1,12),U,3),BCJOB=$P(^BQI(90508,1,12),U,5)
  1.  S STOP=0
  1.  F  S BGPPROV=$O(^BQI(90508,1,14,"B",BGPPROV)) Q:BGPPROV=""  D  Q:STOP
  1.  . D MON^BQIMUPRS(BGPPROV)
  1.  . S $P(^BQI(90508,1,12),U,3)=BGPPROV
  1.  . S ^XTMP("BQIMUMON",BGPPROV)=$P(^BQI(90508,1,12),U,8)_U_$P(^BQI(90508,1,12),U,9)
  1.  . ; If not prohibited, keep running
  1.  . S BQPROH=+$P(^BQI(90508,1,12),U,7)
  1.  . I 'BQPROH Q
  1.  . ; If prohibited, check the date and time to see if the job needs to stop
  1.  . S BQIMUDTM=$$NOW^XLFDT(),BQIMUDT=$P(BQIMUDTM,".",1),BQIMUTIM=$P(BQIMUDTM,".",2)
  1.  . ; if it is a holiday, keep running
  1.  . I $D(^HOLIDAY("B",DT)) Q
  1.  . S CDOW=$$DOW^XLFDT(BQIMUDT,1)
  1.  . ; If day of week is Saturday, keeping running even if prohibited
  1.  . I CDOW=6 Q
  1.  . ; If day of week is Sunday, keeping running even if prohibited
  1.  . I CDOW=0 Q
  1.  . ;If the time plus 3 hours is less than 6 am or greater than 6 pm keep going
  1.  . I $E(BQIMUTIM,1,2)+3<6 Q
  1.  . I $E(BQIMUTIM,1,2)+3>18 Q
  1.  . S STOP=1
  1.  . S ZTDTH=BQIMUDT_".183"
  1.  . S ZTDESC="MU CQ Continue Monthly Compile",ZTRTN="NIN^BQITASK6",ZTIO=""
  1.  . D ^%ZTLOAD
  1.  . S BQIUPD(90508,"1,",12.05)=ZTSK
  1.  . D FILE^DIE("","BQIUPD","ERROR")
  1.  . K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
  1.  ;
  1. HOS ; Hospital CQ
  1.  I $P(^BQI(90508,1,0),U,6)=1 D
  1.  . NEW BGPINDT,BGPMUYF,BGPRTYPE,BGP0RPTH,BGPBEN,X,BQIGREF,FAC,BQTDT,BQTMN,BGPBD,BGPED
  1.  . K BGPIND
  1.  . S BGPINDT=""
  1.  . S BGPMUYF="90595.11"
  1.  . S BGPRTYPE=4,BGP0RPTH="A"
  1.  . S BGPMUT="H" ; BGPMU Hospital Measures
  1.  . S BGPRTYPE=4,BGP0RPTH="A"
  1.  . S BGPBEN=3
  1.  . S X=0 F  S X=$O(^BGPMUIND(BGPMUYF,X)) Q:'X  I $P(^BGPMUIND(BGPMUYF,X,0),U,4)="H" S BGPIND(X)=""
  1.  . S BQIGREF=$NA(^TMP("BQICQMH9",$J)) K @BQIGREF
  1.  . ;
  1.  . S FAC=$$HME^BQIGPUTL()
  1.  . S BGPBD=$P(^BQI(90508,1,12),U,8),BGPED=$P(^BQI(90508,1,12),U,9)
  1.  . S BQTDT=$E(BGPBD,1,5)_"00"
  1.  . S BQTMN=$O(^BQIFAC(FAC,50,"B",BQTDT,""))
  1.  . I BQTMN="" D UPH
  1.  . ; Already data there, don't recalculate and quit
  1.  . ;I $G(^BQIFAC(FAC,50,BQTMN,1,1,0))'="" Q
  1.  . S BGPBD=$P(^BQI(90508,1,12),U,8),BGPED=$P(^BQI(90508,1,12),U,9)
  1.  . ; Previous
  1.  . S BGPPBD="",BGPPED=""
  1.  . ; Baseline
  1.  . S BGPBBD=BGPPBD,BGPBED=BGPPED
  1.  . D BQI^BGPMUEHD(.BQIGREF)
  1.  . K CDEN,CNUM,CEXC,PDEN,PNUM,PEXC,CSORT,PSORT,MTOT
  1.  . S BN=""
  1.  . F  S BN=$O(@BQIGREF@(BN)) Q:BN=""  D
  1.  .. S I=""
  1.  .. F  S I=$O(@BQIGREF@(BN,"C",I)) Q:I=""  D
  1.  ... I $P($G(^BGPMUIND(90596.11,I,0)),U,4)[".ED." D  Q
  1.  .... S MTOT=$P(@BQIGREF@(BN,"C",I),U,2)/60
  1.  .... S CSORT(I,MTOT,BN)="",CSORT(I)=$G(CSORT(I))+1
  1.  ... S CDEN(I)=$G(CDEN(I))+$P($G(@BQIGREF@(BN,"C",I)),U,1)
  1.  ... S CNUM(I)=$G(CNUM(I))+$P($G(@BQIGREF@(BN,"C",I)),U,2)
  1.  ... S CEXC(I)=$G(CEXC(I))+$P($G(@BQIGREF@(BN,"C",I)),U,3)
  1.  . D STORH(50)
  1.  . K @BQIGREF,CSORT,PSORT
  1.  ;
  1.  ;  Set the DATE/TIME MU STOPPED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",4.2)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",4.21)="@"
  1.  S BQIUPD(90508,DA_",",12.03)=+BGPPROV
  1.  I +BGPPROV=0 D
  1.  . S BMDT=$P(^BQI(90508,1,12),U,9),BMDT=$$FMADD^XLFDT(BMDT,1)
  1.  . S BMDT=$E(BMDT,1,5)_"00"
  1.  . I $D(^XTMP("BQIMMON",BMDT)) K ^XTMP("BQIMMON",BMDT)
  1.  . S BQIUPD(90508,DA_",",12.05)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ; Create and send export files
  1.  D EN^BQIMUEXP
  1.  D HOS^BQIMUEXP
  1.  Q
  1.  ;
  1. STORH(NODE) ;
  1.  NEW CVALUE,PVALUE,CT,I,MSN,FAC
  1.  I '$D(@BQIGREF) Q
  1.  S FAC=$$HME^BQIGPUTL()
  1.  I NODE=60 D  Q
  1.  . S $P(^BQIFAC(FAC,2),U,1)=$$NOW^XLFDT()
  1.  . S CT=0
  1.  . S I=0 F  S I=$O(^BGPMUIND(90596.11,I)) Q:'I  D
  1.  .. S MSN=$P(^BGPMUIND(90596.11,I,0),U,1)
  1.  .. I $G(^BGPMUIND(90595.11,MSN,0))="" Q
  1.  .. I $P(^BGPMUIND(90595.11,MSN,0),U,4)'="H" Q
  1.  .. S CT=CT+1,^BQIFAC(FAC,NODE,BQTMN,10,CT,0)=$P(^BGPMUIND(90596.11,I,0),"^",4)_U_$G(CDEN(I))_U_$G(CNUM(I))_U_$G(CEXC(I))
  1.  .. S ^BQIFAC(FAC,NODE,BQTMN,10,"B",$P(^BGPMUIND(90596.11,I,0),"^",4),CT)=""
  1.  ;
  1.  I NODE=50 D  Q
  1.  . S $P(^BQIFAC(FAC,2),U,1)=$$NOW^XLFDT()
  1.  . S CT=0
  1.  . S I=0 F  S I=$O(^BGPMUIND(90596.11,I)) Q:'I  D
  1.  .. S MSN=$P(^BGPMUIND(90596.11,I,0),U,1)
  1.  .. I $G(^BGPMUIND(90595.11,MSN,0))="" Q
  1.  .. I $P(^BGPMUIND(90595.11,MSN,0),U,4)'="H" Q
  1.  .. S CT=CT+1,^BQIFAC(FAC,NODE,BQTMN,1,CT,0)=$P(^BGPMUIND(90596.11,I,0),"^",4)_U_$G(CDEN(I))_U_$G(CNUM(I))_U_$G(CEXC(I))
  1.  .. S ^BQIFAC(FAC,NODE,BQTMN,1,"B",$P(^BGPMUIND(90596.11,I,0),"^",4),CT)=""
  1.  ;
  1.  K ^BQIFAC(FAC,NODE),^BQIFAC(FAC,NODE,"B")
  1.  I NODE=11 S $P(^BQIFAC(FAC,1),U,1,4)=BGPBD_U_BGPED_U_BGPPBD_U_BGPPED
  1.  I NODE=21 S $P(^BQIFAC(FAC,1),U,5,8)=BGPBD_U_BGPED_U_BGPPBD_U_BGPPED
  1.  S CT=0
  1.  S I=0 F  S I=$O(^BGPMUIND(90596.11,I)) Q:'I  D
  1.  . S MSN=$P(^BGPMUIND(90596.11,I,0),U,1)
  1.  . I $G(^BGPMUIND(90595.11,MSN,0))="" Q
  1.  . I $P(^BGPMUIND(90595.11,MSN,0),U,4)'="H" Q
  1.  . I $P($G(^BGPMUIND(90596.11,I,0)),U,4)[".ED." D
  1.  .. S CVALUE=$$MED(I,.CSORT),PVALUE=$$MED(I,.PSORT)
  1.  .. S CT=CT+1,^BQIFAC(FAC,NODE,CT,0)=$P(^BGPMUIND(90596.11,I,0),"^",4)_U_$P(CVALUE,U,1)_U_$P(CVALUE,U,2)_U_$G(CEXC(I))_U_$P(PVALUE,U,1)_U_$P(PVALUE,U,2)_U_$G(PEXC(I))
  1.  . I $P($G(^BGPMUIND(90596.11,I,0)),U,4)'[".ED." D
  1.  .. S CT=CT+1,^BQIFAC(FAC,NODE,CT,0)=$P(^BGPMUIND(90596.11,I,0),"^",4)_U_$G(CDEN(I))_U_$G(CNUM(I))_U_$G(CEXC(I))_U_$G(PDEN(I))_U_$G(PNUM(I))_U_$G(PEXC(I))
  1.  . S ^BQIFAC(FAC,NODE,"B",$P(^BGPMUIND(90596.11,I,0),"^",4),CT)=""
  1.  Q
  1.  ;
  1. MED(ITM,LIST) ;EP - Find Median for LIST
  1.  ; Input
  1.  ;    ITM  - Which measure to check list for
  1.  ;    LIST - By ITM, the list of sorted values
  1.  NEW CNT,MID,CT,PVAL,VAL,TOT,DFN,MED
  1.  S CNT=$G(LIST(ITM))
  1.  I CNT=1 Q $O(LIST(ITM,""))_U_1
  1.  I CNT=2 D  Q (TOT/CNT)_U_CNT
  1.  . S TOT=0,VAL=""
  1.  . F  S VAL=$O(LIST(ITM,VAL)) Q:VAL=""  D
  1.  .. S DFN="" F  S DFN=$O(LIST(ITM,VAL,DFN)) Q:DFN=""  S TOT=TOT+VAL
  1.  ;
  1.  ;S MID=(CNT+1)\2
  1.  S MID=CNT\2
  1.  S CT=0,VAL="",QFL=0,MED="",TOT=0
  1.  F  S VAL=$O(LIST(ITM,VAL)) Q:VAL=""  D  Q:QFL
  1.  . S DFN=""
  1.  . F  S DFN=$O(LIST(ITM,VAL,DFN)) Q:DFN=""  D
  1.  .. S CT=CT+1,NVAL=$O(LIST(ITM,VAL))
  1.  .. I CT=MID S TOT=TOT+VAL+NVAL,MED=(TOT/2),QFL=1 Q
  1.  .. S PVAL=VAL
  1.  Q MED_U_CNT
  1.  ;
  1. UPH ;EP Update Hospital
  1.  NEW BEGDT,ENDT,TMFRAME,XX,V,I,ERROR,BQIUPD
  1.  S BEGDT=$P($G(^BQI(90508,1,12)),U,8),ENDT=$P($G(^BQI(90508,1,12)),U,9)
  1.  ;S TMFRAME=$$FMTE^BQIUL1(BEGDT)_" - "_$$FMTE^BQIUL1(ENDT)
  1.  ;
  1.  I $G(^BQIFAC(FAC,50,0))="" S ^BQIFAC(FAC,50,0)="^90505.66D^^"
  1.  S BQDATE=$E(BEGDT,1,5)_"00"
  1.  NEW DA,X,IENS
  1.  S DA(1)=FAC,DIC="^BQIFAC("_DA(1)_",50,",X=BQDATE,DIC(0)="LNZ",DLAYGO=90505.66,DIC("P")=DLAYGO
  1.  D ^DIC
  1.  S DA=+Y I DA=-1 Q
  1.  S BQTMN=DA
  1.  Q