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

BQIMUMON.m

Go to the documentation of this file. 
  1. BQIMUMON ;GDIT/HS/ALA-MU Monthly ; 16 Sep 2011  9:47 AM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**1,3,4**;Apr 18, 2012;Build 66
  1.  ;
  1.  ;
  1. EN(BQDATE) ;EP - MU calculations
  1.  ; 
  1.  S QFL=0
  1.  ; If passing a date in
  1.  I $G(BQDATE)'="" D
  1.  . S BQMON=$E(BQDATE,4,5),CYR=$E(BQDATE,1,3),PYR=CYR-1
  1.  . S BQDTE=$P($T(BQM+BQMON),";;",2)
  1.  . S BQMON=$P(BQDTE,U,1)
  1.  . I $L(BQMON)=1 S BQMON="0"_BQMON
  1.  . S BTMFRM=@($P(BQDTE,U,4))_$P(BQDTE,U,3)_"01"
  1.  . S BEGDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"01"
  1.  . S EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
  1.  . S ENDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_$P(EDAY,U,+$P(BQDTE,U,1))
  1.  . S ETMFRM=ENDT
  1.  . S BQDATE=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"00"
  1.  ; If no date, then if not the first of the month, quit
  1.  I $G(BQDATE)="" D  Q:QFL
  1.  . I $E(DT,6,7)'="01" D CHK Q:QFL
  1.  . I $D(^XTMP("BQIMMON")),$O(^XTMP("BQIMMON",""),-1)<DT S ^XTMP("BQIMMON",DT)="",^XTMP("BQIMMONP",DT)="",QFL=1 Q
  1.  . I $D(^XTMP("BQIMMON",DT)),$D(^XTMP("BQIMMONP",DT)) S QFL=1 Q
  1.  . S BQMON=$E(DT,4,5),CYR=$E(DT,1,3),PYR=CYR-1
  1.  . S BQDTE=$P($T(BQM+BQMON),";;",2)
  1.  . S BQMON=$P(BQDTE,U,1)
  1.  . I $L(BQMON)=1 S BQMON="0"_BQMON
  1.  . S BTMFRM=@($P(BQDTE,U,4))_$P(BQDTE,U,3)_"01"
  1.  . S BEGDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"01"
  1.  . S EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
  1.  . S ENDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_$P(EDAY,U,+$P(BQDTE,U,1))
  1.  . S ETMFRM=ENDT
  1.  . S BQDATE=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"00"
  1.  ;
  1.  I $G(^BQI(90508,1,19,0))="" S ^BQI(90508,1,19,0)="^90508.019^^"
  1.  NEW DA,X,IENS,DIC,DLAYGO
  1.  S DA(1)=1,DIC="^BQI(90508,"_DA(1)_",19,",X=$$FMTE^BQIUL1(BQDATE),DIC(0)="LZ",DLAYGO=90508.019
  1.  D ^DIC
  1.  S DA=+Y I DA=-1 K DO,DD D FILE^DICN S DA=+Y
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90508.019,IENS,.01)=$$FMTE^BQIUL1(BQDATE)
  1.  S BQIUPD(90508.019,IENS,.02)=BEGDT,BQIUPD(90508.019,IENS,.03)=ENDT
  1.  S BQIUPD(90508.019,IENS,.04)=30,BQIUPD(90508.019,IENS,.05)=1
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  S FAC=$O(^BQIFAC(0))
  1.  I FAC="" D
  1.  . S FAC=$$HME^BQIGPUTL()
  1.  . S ^BQIFAC(FAC,0)=FAC,^BQIFAC("B",FAC,FAC)=""
  1.  Q
  1.  ;
  1. CQ(BQDATE) ;EP - Set up Task for CQ
  1.  NEW BQMON,CYR,PYR,YR,QFL,BEGDT,ENDT,EDAY,BQDTE,XX,TMFRAME
  1.  NEW BGPPROV,I,V,Y,BTMFRM,ETMFRM
  1.  D EN(BQDATE) Q:QFL
  1.  S BQIUPD(90508,"1,",12.08)=BEGDT,BQIUPD(90508,"1,",12.09)=ENDT
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
  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.  Q
  1.  ;
  1. PF(BQDATE) ;EP - MU Performance
  1.  NEW BQMON,CYR,PYR,YR,QFL,BEGDT,ENDT,EDAY,BQDTE,XX,TMFRAME
  1.  NEW BGPPROV,I,V,Y,BTMFRM,ETMFRM
  1.  D EN(BQDATE) Q:QFL
  1.  S BQIUPD(90508,"1,",9.01)=BEGDT,BQIUPD(90508,"1,",9.02)=ENDT
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  ; Providers
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,30)
  1.  S ZTDESC="MU Performance Monthly Compile",ZTRTN="NIN^BQITASK7",ZTIO=""
  1.  D ^%ZTLOAD
  1.  S BQIUPD(90508,"1,",12.06)=ZTSK
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
  1.  Q
  1.  ;
  1. PRVC ;EP Providers for CQ
  1.  S BGPPROV=""
  1.  F  S BGPPROV=$O(^BQI(90508,1,14,"B",BGPPROV)) Q:BGPPROV=""  D
  1.  . I $G(^BQIPROV(BGPPROV,0))="" S ^BQIPROV(BGPPROV,0)=BGPPROV,^BQIPROV("B",BGPPROV,BGPPROV)=""
  1.  . I $G(^BQIPROV(BGPPROV,50,0))="" S ^BQIPROV(BGPPROV,50,0)="^90505.44D^^"
  1.  . NEW DA,X,IENS
  1.  . S DA(1)=BGPPROV,DIC="^BQIPROV("_DA(1)_",50,",X=BQDATE,DIC(0)="LNZ",DLAYGO=90505.45,DIC("P")=DLAYGO
  1.  . D ^DIC
  1.  . S DA=+Y I DA=-1 Q
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  Q
  1.  ;
  1. PRVP ;EP Providers for performance
  1.  S BGPPROV=""
  1.  F  S BGPPROV=$O(^BQI(90508,1,14,"B",BGPPROV)) Q:BGPPROV=""  D
  1.  . I $G(^BQIPROV(BGPPROV,0))="" S ^BQIPROV(BGPPROV,0)=BGPPROV,^BQIPROV("B",BGPPROV,BGPPROV)=""
  1.  . I $G(^BQIPROV(BGPPROV,40,0))="" S ^BQIPROV(BGPPROV,40,0)="^90505.45D^^"
  1.  . S DA(1)=BGPPROV,DIC="^BQIPROV("_DA(1)_",40,",X=BQDATE,DIC(0)="LNZ",DLAYGO=90505.44,DIC("P")=DLAYGO
  1.  . D ^DIC
  1.  . S DA=+Y I DA=-1 Q
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  Q
  1.  ;
  1. CHK ; EP - check whether month ran or not
  1.  NEW BQMON,CYR,PYR,BQDTE,BQMON,BQDATE,BQMMON
  1.  S QFL=0
  1.  S BQMON=$E(DT,4,5),CYR=$E(DT,1,3),PYR=CYR-1
  1.  S BQDTE=$P($T(BQM+BQMON),";;",2)
  1.  S BQMON=$P(BQDTE,U,1)
  1.  I $L(BQMON)=1 S BQMON="0"_BQMON
  1.  S BQDATE=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"00"
  1.  S BQMMON=$$FMTE^BQIUL1(BQDATE)
  1.  I $D(^BQI(90508,1,19,"B",BQMMON)) S QFL=1 Q
  1.  S BQMMON=$E(DT,1,5)_"01"
  1.  S ^XTMP("BQIMMON",BQMMON)="",QFL=1
  1.  Q
  1.  ;
  1. BQM ;
  1.  ;;12^PYR^10^PYR
  1.  ;;01^CYR^11^PYR
  1.  ;;02^CYR^12^PYR
  1.  ;;03^CYR^01^CYR
  1.  ;;04^CYR^02^CYR
  1.  ;;05^CYR^03^CYR
  1.  ;;06^CYR^04^CYR
  1.  ;;07^CYR^05^CYR
  1.  ;;08^CYR^06^CYR
  1.  ;;09^CYR^07^CYR
  1.  ;;10^CYR^08^CYR
  1.  ;;11^CYR^09^CYR