BQIMUMON ;GDIT/HS/ALA-MU Monthly ; 16 Sep 2011 9:47 AM
;;2.3;ICARE MANAGEMENT SYSTEM;**1,3,4**;Apr 18, 2012;Build 66
;
;
EN(BQDATE) ;EP - MU calculations
;
S QFL=0
; If passing a date in
I $G(BQDATE)'="" D
. S BQMON=$E(BQDATE,4,5),CYR=$E(BQDATE,1,3),PYR=CYR-1
. S BQDTE=$P($T(BQM+BQMON),";;",2)
. S BQMON=$P(BQDTE,U,1)
. I $L(BQMON)=1 S BQMON="0"_BQMON
. S BTMFRM=@($P(BQDTE,U,4))_$P(BQDTE,U,3)_"01"
. S BEGDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"01"
. S EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
. S ENDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_$P(EDAY,U,+$P(BQDTE,U,1))
. S ETMFRM=ENDT
. S BQDATE=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"00"
; If no date, then if not the first of the month, quit
I $G(BQDATE)="" D Q:QFL
. I $E(DT,6,7)'="01" D CHK Q:QFL
. I $D(^XTMP("BQIMMON")),$O(^XTMP("BQIMMON",""),-1)<DT S ^XTMP("BQIMMON",DT)="",^XTMP("BQIMMONP",DT)="",QFL=1 Q
. I $D(^XTMP("BQIMMON",DT)),$D(^XTMP("BQIMMONP",DT)) S QFL=1 Q
. S BQMON=$E(DT,4,5),CYR=$E(DT,1,3),PYR=CYR-1
. S BQDTE=$P($T(BQM+BQMON),";;",2)
. S BQMON=$P(BQDTE,U,1)
. I $L(BQMON)=1 S BQMON="0"_BQMON
. S BTMFRM=@($P(BQDTE,U,4))_$P(BQDTE,U,3)_"01"
. S BEGDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"01"
. S EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
. S ENDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_$P(EDAY,U,+$P(BQDTE,U,1))
. S ETMFRM=ENDT
. S BQDATE=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"00"
;
I $G(^BQI(90508,1,19,0))="" S ^BQI(90508,1,19,0)="^90508.019^^"
NEW DA,X,IENS,DIC,DLAYGO
S DA(1)=1,DIC="^BQI(90508,"_DA(1)_",19,",X=$$FMTE^BQIUL1(BQDATE),DIC(0)="LZ",DLAYGO=90508.019
D ^DIC
S DA=+Y I DA=-1 K DO,DD D FILE^DICN S DA=+Y
S IENS=$$IENS^DILF(.DA)
S BQIUPD(90508.019,IENS,.01)=$$FMTE^BQIUL1(BQDATE)
S BQIUPD(90508.019,IENS,.02)=BEGDT,BQIUPD(90508.019,IENS,.03)=ENDT
S BQIUPD(90508.019,IENS,.04)=30,BQIUPD(90508.019,IENS,.05)=1
D FILE^DIE("","BQIUPD","ERROR")
S FAC=$O(^BQIFAC(0))
I FAC="" D
. S FAC=$$HME^BQIGPUTL()
. S ^BQIFAC(FAC,0)=FAC,^BQIFAC("B",FAC,FAC)=""
Q
;
CQ(BQDATE) ;EP - Set up Task for CQ
NEW BQMON,CYR,PYR,YR,QFL,BEGDT,ENDT,EDAY,BQDTE,XX,TMFRAME
NEW BGPPROV,I,V,Y,BTMFRM,ETMFRM
D EN(BQDATE) Q:QFL
S BQIUPD(90508,"1,",12.08)=BEGDT,BQIUPD(90508,"1,",12.09)=ENDT
D FILE^DIE("","BQIUPD","ERROR")
;
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
S ZTDESC="MU CQ Monthly Compile",ZTRTN="NIN^BQITASK6",ZTIO=""
D ^%ZTLOAD
S BQIUPD(90508,"1,",12.05)=ZTSK
D FILE^DIE("","BQIUPD","ERROR")
K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
Q
;
PF(BQDATE) ;EP - MU Performance
NEW BQMON,CYR,PYR,YR,QFL,BEGDT,ENDT,EDAY,BQDTE,XX,TMFRAME
NEW BGPPROV,I,V,Y,BTMFRM,ETMFRM
D EN(BQDATE) Q:QFL
S BQIUPD(90508,"1,",9.01)=BEGDT,BQIUPD(90508,"1,",9.02)=ENDT
D FILE^DIE("","BQIUPD","ERROR")
;
; Providers
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,30)
S ZTDESC="MU Performance Monthly Compile",ZTRTN="NIN^BQITASK7",ZTIO=""
D ^%ZTLOAD
S BQIUPD(90508,"1,",12.06)=ZTSK
D FILE^DIE("","BQIUPD","ERROR")
K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
Q
;
PRVC ;EP Providers for CQ
S BGPPROV=""
F S BGPPROV=$O(^BQI(90508,1,14,"B",BGPPROV)) Q:BGPPROV="" D
. I $G(^BQIPROV(BGPPROV,0))="" S ^BQIPROV(BGPPROV,0)=BGPPROV,^BQIPROV("B",BGPPROV,BGPPROV)=""
. I $G(^BQIPROV(BGPPROV,50,0))="" S ^BQIPROV(BGPPROV,50,0)="^90505.44D^^"
. NEW DA,X,IENS
. S DA(1)=BGPPROV,DIC="^BQIPROV("_DA(1)_",50,",X=BQDATE,DIC(0)="LNZ",DLAYGO=90505.45,DIC("P")=DLAYGO
. D ^DIC
. S DA=+Y I DA=-1 Q
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
Q
;
PRVP ;EP Providers for performance
S BGPPROV=""
F S BGPPROV=$O(^BQI(90508,1,14,"B",BGPPROV)) Q:BGPPROV="" D
. I $G(^BQIPROV(BGPPROV,0))="" S ^BQIPROV(BGPPROV,0)=BGPPROV,^BQIPROV("B",BGPPROV,BGPPROV)=""
. I $G(^BQIPROV(BGPPROV,40,0))="" S ^BQIPROV(BGPPROV,40,0)="^90505.45D^^"
. S DA(1)=BGPPROV,DIC="^BQIPROV("_DA(1)_",40,",X=BQDATE,DIC(0)="LNZ",DLAYGO=90505.44,DIC("P")=DLAYGO
. D ^DIC
. S DA=+Y I DA=-1 Q
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
Q
;
CHK ; EP - check whether month ran or not
NEW BQMON,CYR,PYR,BQDTE,BQMON,BQDATE,BQMMON
S QFL=0
S BQMON=$E(DT,4,5),CYR=$E(DT,1,3),PYR=CYR-1
S BQDTE=$P($T(BQM+BQMON),";;",2)
S BQMON=$P(BQDTE,U,1)
I $L(BQMON)=1 S BQMON="0"_BQMON
S BQDATE=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"00"
S BQMMON=$$FMTE^BQIUL1(BQDATE)
I $D(^BQI(90508,1,19,"B",BQMMON)) S QFL=1 Q
S BQMMON=$E(DT,1,5)_"01"
S ^XTMP("BQIMMON",BQMMON)="",QFL=1
Q
;
BQM ;
;;12^PYR^10^PYR
;;01^CYR^11^PYR
;;02^CYR^12^PYR
;;03^CYR^01^CYR
;;04^CYR^02^CYR
;;05^CYR^03^CYR
;;06^CYR^04^CYR
;;07^CYR^05^CYR
;;08^CYR^06^CYR
;;09^CYR^07^CYR
;;10^CYR^08^CYR
;;11^CYR^09^CYR
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
+2 ;
+3 ;
EN(BQDATE) ;EP - MU calculations
+1 ;
+2 SET QFL=0
+3 ; If passing a date in
+4 IF $GET(BQDATE)'=""
Begin DoDot:1
+5 SET BQMON=$EXTRACT(BQDATE,4,5)
SET CYR=$EXTRACT(BQDATE,1,3)
SET PYR=CYR-1
+6 SET BQDTE=$PIECE($TEXT(BQM+BQMON),";;",2)
+7 SET BQMON=$PIECE(BQDTE,U,1)
+8 IF $LENGTH(BQMON)=1
SET BQMON="0"_BQMON
+9 SET BTMFRM=@($PIECE(BQDTE,U,4))_$PIECE(BQDTE,U,3)_"01"
+10 SET BEGDT=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_"01"
+11 SET EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
+12 SET ENDT=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_$PIECE(EDAY,U,+$PIECE(BQDTE,U,1))
+13 SET ETMFRM=ENDT
+14 SET BQDATE=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_"00"
End DoDot:1
+15 ; If no date, then if not the first of the month, quit
+16 IF $GET(BQDATE)=""
Begin DoDot:1
+17 IF $EXTRACT(DT,6,7)'="01"
DO CHK
IF QFL
QUIT
+18 IF $DATA(^XTMP("BQIMMON"))
IF $ORDER(^XTMP("BQIMMON",""),-1)<DT
SET ^XTMP("BQIMMON",DT)=""
SET ^XTMP("BQIMMONP",DT)=""
SET QFL=1
QUIT
+19 IF $DATA(^XTMP("BQIMMON",DT))
IF $DATA(^XTMP("BQIMMONP",DT))
SET QFL=1
QUIT
+20 SET BQMON=$EXTRACT(DT,4,5)
SET CYR=$EXTRACT(DT,1,3)
SET PYR=CYR-1
+21 SET BQDTE=$PIECE($TEXT(BQM+BQMON),";;",2)
+22 SET BQMON=$PIECE(BQDTE,U,1)
+23 IF $LENGTH(BQMON)=1
SET BQMON="0"_BQMON
+24 SET BTMFRM=@($PIECE(BQDTE,U,4))_$PIECE(BQDTE,U,3)_"01"
+25 SET BEGDT=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_"01"
+26 SET EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
+27 SET ENDT=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_$PIECE(EDAY,U,+$PIECE(BQDTE,U,1))
+28 SET ETMFRM=ENDT
+29 SET BQDATE=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_"00"
End DoDot:1
IF QFL
QUIT
+30 ;
+31 IF $GET(^BQI(90508,1,19,0))=""
SET ^BQI(90508,1,19,0)="^90508.019^^"
+32 NEW DA,X,IENS,DIC,DLAYGO
+33 SET DA(1)=1
SET DIC="^BQI(90508,"_DA(1)_",19,"
SET X=$$FMTE^BQIUL1(BQDATE)
SET DIC(0)="LZ"
SET DLAYGO=90508.019
+34 DO ^DIC
+35 SET DA=+Y
IF DA=-1
KILL DO,DD
DO FILE^DICN
SET DA=+Y
+36 SET IENS=$$IENS^DILF(.DA)
+37 SET BQIUPD(90508.019,IENS,.01)=$$FMTE^BQIUL1(BQDATE)
+38 SET BQIUPD(90508.019,IENS,.02)=BEGDT
SET BQIUPD(90508.019,IENS,.03)=ENDT
+39 SET BQIUPD(90508.019,IENS,.04)=30
SET BQIUPD(90508.019,IENS,.05)=1
+40 DO FILE^DIE("","BQIUPD","ERROR")
+41 SET FAC=$ORDER(^BQIFAC(0))
+42 IF FAC=""
Begin DoDot:1
+43 SET FAC=$$HME^BQIGPUTL()
+44 SET ^BQIFAC(FAC,0)=FAC
SET ^BQIFAC("B",FAC,FAC)=""
End DoDot:1
+45 QUIT
+46 ;
CQ(BQDATE) ;EP - Set up Task for CQ
+1 NEW BQMON,CYR,PYR,YR,QFL,BEGDT,ENDT,EDAY,BQDTE,XX,TMFRAME
+2 NEW BGPPROV,I,V,Y,BTMFRM,ETMFRM
+3 DO EN(BQDATE)
IF QFL
QUIT
+4 SET BQIUPD(90508,"1,",12.08)=BEGDT
SET BQIUPD(90508,"1,",12.09)=ENDT
+5 DO FILE^DIE("","BQIUPD","ERROR")
+6 ;
+7 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
+8 SET ZTDESC="MU CQ Monthly Compile"
SET ZTRTN="NIN^BQITASK6"
SET ZTIO=""
+9 DO ^%ZTLOAD
+10 SET BQIUPD(90508,"1,",12.05)=ZTSK
+11 DO FILE^DIE("","BQIUPD","ERROR")
+12 KILL ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
+13 QUIT
+14 ;
PF(BQDATE) ;EP - MU Performance
+1 NEW BQMON,CYR,PYR,YR,QFL,BEGDT,ENDT,EDAY,BQDTE,XX,TMFRAME
+2 NEW BGPPROV,I,V,Y,BTMFRM,ETMFRM
+3 DO EN(BQDATE)
IF QFL
QUIT
+4 SET BQIUPD(90508,"1,",9.01)=BEGDT
SET BQIUPD(90508,"1,",9.02)=ENDT
+5 DO FILE^DIE("","BQIUPD","ERROR")
+6 ;
+7 ; Providers
+8 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,30)
+9 SET ZTDESC="MU Performance Monthly Compile"
SET ZTRTN="NIN^BQITASK7"
SET ZTIO=""
+10 DO ^%ZTLOAD
+11 SET BQIUPD(90508,"1,",12.06)=ZTSK
+12 DO FILE^DIE("","BQIUPD","ERROR")
+13 KILL ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
+14 QUIT
+15 ;
PRVC ;EP Providers for CQ
+1 SET BGPPROV=""
+2 FOR
SET BGPPROV=$ORDER(^BQI(90508,1,14,"B",BGPPROV))
IF BGPPROV=""
QUIT
Begin DoDot:1
+3 IF $GET(^BQIPROV(BGPPROV,0))=""
SET ^BQIPROV(BGPPROV,0)=BGPPROV
SET ^BQIPROV("B",BGPPROV,BGPPROV)=""
+4 IF $GET(^BQIPROV(BGPPROV,50,0))=""
SET ^BQIPROV(BGPPROV,50,0)="^90505.44D^^"
+5 NEW DA,X,IENS
+6 SET DA(1)=BGPPROV
SET DIC="^BQIPROV("_DA(1)_",50,"
SET X=BQDATE
SET DIC(0)="LNZ"
SET DLAYGO=90505.45
SET DIC("P")=DLAYGO
+7 DO ^DIC
+8 SET DA=+Y
IF DA=-1
QUIT
End DoDot:1
+9 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+10 QUIT
+11 ;
PRVP ;EP Providers for performance
+1 SET BGPPROV=""
+2 FOR
SET BGPPROV=$ORDER(^BQI(90508,1,14,"B",BGPPROV))
IF BGPPROV=""
QUIT
Begin DoDot:1
+3 IF $GET(^BQIPROV(BGPPROV,0))=""
SET ^BQIPROV(BGPPROV,0)=BGPPROV
SET ^BQIPROV("B",BGPPROV,BGPPROV)=""
+4 IF $GET(^BQIPROV(BGPPROV,40,0))=""
SET ^BQIPROV(BGPPROV,40,0)="^90505.45D^^"
+5 SET DA(1)=BGPPROV
SET DIC="^BQIPROV("_DA(1)_",40,"
SET X=BQDATE
SET DIC(0)="LNZ"
SET DLAYGO=90505.44
SET DIC("P")=DLAYGO
+6 DO ^DIC
+7 SET DA=+Y
IF DA=-1
QUIT
End DoDot:1
+8 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+9 QUIT
+10 ;
CHK ; EP - check whether month ran or not
+1 NEW BQMON,CYR,PYR,BQDTE,BQMON,BQDATE,BQMMON
+2 SET QFL=0
+3 SET BQMON=$EXTRACT(DT,4,5)
SET CYR=$EXTRACT(DT,1,3)
SET PYR=CYR-1
+4 SET BQDTE=$PIECE($TEXT(BQM+BQMON),";;",2)
+5 SET BQMON=$PIECE(BQDTE,U,1)
+6 IF $LENGTH(BQMON)=1
SET BQMON="0"_BQMON
+7 SET BQDATE=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_"00"
+8 SET BQMMON=$$FMTE^BQIUL1(BQDATE)
+9 IF $DATA(^BQI(90508,1,19,"B",BQMMON))
SET QFL=1
QUIT
+10 SET BQMMON=$EXTRACT(DT,1,5)_"01"
+11 SET ^XTMP("BQIMMON",BQMMON)=""
SET QFL=1
+12 QUIT
+13 ;
BQM ;
+1 ;;12^PYR^10^PYR
+2 ;;01^CYR^11^PYR
+3 ;;02^CYR^12^PYR
+4 ;;03^CYR^01^CYR
+5 ;;04^CYR^02^CYR
+6 ;;05^CYR^03^CYR
+7 ;;06^CYR^04^CYR
+8 ;;07^CYR^05^CYR
+9 ;;08^CYR^06^CYR
+10 ;;09^CYR^07^CYR
+11 ;;10^CYR^08^CYR
+12 ;;11^CYR^09^CYR
