BQIMUTIM ;GDIT/HS/ALA-MU CQ Timeframes and Periods ; 10 Nov 2011 8:17 AM
;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
;
;
GTM ; Get period based on timeframe and starting month
; Input Parameters
; PERIOD - Starting Month
; TMFRAME - 30 = 1 Month, 90 = 90 Days, 12 = 1 Year
; Output Parameters
; CPER - Current Period
; PPER - Previous Period
; BQCDAR - Array of current months
; BQPDAR - Array of previous months
;
NEW CURN,BEGDT,ENDT,PEDT,PRVDT,PRMON,PRVN,PBGDT,PENDT,BQMON,BQDTE,CTMBG,EDAY,CTMEN
NEW BM,TMDT,PTMBG,PTMEN,CYR,PYR,NYR
S CURN=$O(^BQI(90508,1,19,"B",PERIOD,""))
S BEGDT=$P(^BQI(90508,1,19,CURN,0),U,2),ENDT=$P(^BQI(90508,1,19,CURN,0),U,3)
;
;S CYR=$E(DT,1,3),PYR=CYR-1,NYR=CYR+1
;
K BQCDAR,BQPDAR
I TMFRAME=30 D
. S CYR=$E(BEGDT,1,3),PYR=CYR-1,NYR=CYR+1
. S CPER=$$FMTE^BQIUL1(BEGDT)_" - "_$$FMTE^BQIUL1(ENDT)
. S CURDT=$E(BEGDT,1,5)_"00",BQCDAR(CURDT)=""
. S PEDT=$$FMADD^XLFDT(BEGDT,-1),PRVDT=$E(PEDT,1,5)_"00",BQPDAR(PRVDT)=""
. S PRMON=$$FMTE^BQIUL1(PRVDT)
. S PRVN=$O(^BQI(90508,1,19,"B",PRMON,""))
. I PRVN="" S PPER="No Previous Period" Q
. S PBGDT=$P(^BQI(90508,1,19,PRVN,0),U,2),PENDT=$P(^BQI(90508,1,19,PRVN,0),U,3)
. S PPER=$$FMTE^BQIUL1(PBGDT)_" - "_$$FMTE^BQIUL1(PENDT)
;
I TMFRAME=90 D
. S CYR=$E(BEGDT,1,3),PYR=CYR-1,NYR=CYR+1
. S BQMON=$E(BEGDT,4,5)
. S BQDTE=$P($T(BQM+BQMON),";;",2)
. S CTMBG=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"01"
. S CURN=$O(^BQI(90508,1,19,"B",PERIOD,""))
. S EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
. S CTMEN=@($P(BQDTE,U,6))_$P(BQDTE,U,5)_$P(EDAY,U,+$P(BQDTE,U,5))
. S BQCDAR($E(CTMBG,1,5)_"00")="",BQCDAR($E(CTMEN,1,5)_"00")=""
. S BQCDAR(@($P(BQDTE,U,4))_$P(BQDTE,U,3)_"00")=""
. S CPER=$$FMTE^BQIUL1(CTMBG)_" - "_$$FMTE^BQIUL1(CTMEN)
. S PTMBG=@($P(BQDTE,U,8))_$P(BQDTE,U,7)_"01"
. S PTMEN=@($P(BQDTE,U,12))_$P(BQDTE,U,11)_$P(EDAY,U,+$P(BQDTE,U,1))
. S PRVN=$O(^BQI(90508,1,19,"B",$E(PTMBG,1,5)_"00",""))
. S BQPDAR($E(PTMBG,1,5)_"00")="",BQPDAR($E(PTMEN,1,5)_"00")=""
. S BQPDAR(@($P(BQDTE,U,10))_$P(BQDTE,U,9)_"00")=""
. S PPER=$$FMTE^BQIUL1(PTMBG)_" - "_$$FMTE^BQIUL1(PTMEN)
;
I TMFRAME=12 D
. S CYR=$E(BEGDT,1,3),PYR=CYR-1,NYR=CYR+1
. S EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
. S BQMON=$E(BEGDT,4,5)
. S BQDTE=$P($T(BQM+BQMON),";;",2)
. S CTMBG=BEGDT
. S CTMEN=@($P(BQDTE,U,14))_$P(BQDTE,U,13)_$P(EDAY,U,+$P(BQDTE,U,13))
. S PTMBG=@($P(BQDTE,U,15))_$P(BQDTE,U,1)_"01"
. S PTMEN=@($P(BQDTE,U,16))_$P(BQDTE,U,13)_$P(EDAY,U,+$P(BQDTE,U,13))
. S CPER=$$FMTE^BQIUL1(CTMBG)_" - "_$$FMTE^BQIUL1(CTMEN)
. S PPER=$$FMTE^BQIUL1(PTMBG)_" - "_$$FMTE^BQIUL1(PTMEN)
. ;
. F BM=$P(BQDTE,U,1):1:12 S TMDT=@($P(BQDTE,U,2))_$S($L(BM)=1:"0"_BM,1:BM)_"00",BQCDAR(TMDT)=""
. F BM=1:1:$P(BQDTE,U,13) S TMDT=@($P(BQDTE,U,14))_$S($L(BM)=1:"0"_BM,1:BM)_"00",BQCDAR(TMDT)=""
. F BM=$P(BQDTE,U,1):1:12 S TMDT=@($P(BQDTE,U,15))_$S($L(BM)=1:"0"_BM,1:BM)_"00",BQPDAR(TMDT)=""
. F BM=1:1:$P(BQDTE,U,13) S TMDT=@($P(BQDTE,U,16))_$S($L(BM)=1:"0"_BM,1:BM)_"00",BQPDAR(TMDT)=""
Q
;
BQM ; Period formats
;;01^CYR^02^CYR^03^CYR^10^PYR^11^PYR^12^PYR^12^CYR^PYR^PYR
;;02^CYR^03^CYR^04^CYR^11^PYR^12^PYR^01^CYR^01^NYR^PYR^CYR
;;03^CYR^04^CYR^05^CYR^12^PYR^01^CYR^02^CYR^02^NYR^PYR^CYR
;;04^CYR^05^CYR^06^CYR^01^CYR^02^CYR^03^CYR^03^NYR^PYR^CYR
;;05^CYR^06^CYR^07^CYR^02^CYR^03^CYR^04^CYR^04^NYR^PYR^CYR
;;06^CYR^07^CYR^08^CYR^03^CYR^04^CYR^05^CYR^05^NYR^PYR^CYR
;;07^CYR^08^CYR^09^CYR^04^CYR^05^CYR^06^CYR^06^NYR^PYR^CYR
;;08^CYR^09^CYR^10^CYR^05^CYR^06^CYR^07^CYR^07^NYR^PYR^CYR
;;09^CYR^10^CYR^11^CYR^06^CYR^07^CYR^08^CYR^08^NYR^PYR^CYR
;;10^CYR^11^CYR^12^CYR^07^CYR^08^CYR^09^CYR^09^NYR^PYR^CYR
;;11^CYR^12^CYR^01^NYR^08^CYR^09^CYR^10^CYR^10^NYR^PYR^CYR
;;12^CYR^01^NYR^02^NYR^09^CYR^10^CYR^11^CYR^11^NYR^PYR^CYR
BQIMUTIM ;GDIT/HS/ALA-MU CQ Timeframes and Periods ; 10 Nov 2011 8:17 AM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
+2 ;
+3 ;
GTM ; Get period based on timeframe and starting month
+1 ; Input Parameters
+2 ; PERIOD - Starting Month
+3 ; TMFRAME - 30 = 1 Month, 90 = 90 Days, 12 = 1 Year
+4 ; Output Parameters
+5 ; CPER - Current Period
+6 ; PPER - Previous Period
+7 ; BQCDAR - Array of current months
+8 ; BQPDAR - Array of previous months
+9 ;
+10 NEW CURN,BEGDT,ENDT,PEDT,PRVDT,PRMON,PRVN,PBGDT,PENDT,BQMON,BQDTE,CTMBG,EDAY,CTMEN
+11 NEW BM,TMDT,PTMBG,PTMEN,CYR,PYR,NYR
+12 SET CURN=$ORDER(^BQI(90508,1,19,"B",PERIOD,""))
+13 SET BEGDT=$PIECE(^BQI(90508,1,19,CURN,0),U,2)
SET ENDT=$PIECE(^BQI(90508,1,19,CURN,0),U,3)
+14 ;
+15 ;S CYR=$E(DT,1,3),PYR=CYR-1,NYR=CYR+1
+16 ;
+17 KILL BQCDAR,BQPDAR
+18 IF TMFRAME=30
Begin DoDot:1
+19 SET CYR=$EXTRACT(BEGDT,1,3)
SET PYR=CYR-1
SET NYR=CYR+1
+20 SET CPER=$$FMTE^BQIUL1(BEGDT)_" - "_$$FMTE^BQIUL1(ENDT)
+21 SET CURDT=$EXTRACT(BEGDT,1,5)_"00"
SET BQCDAR(CURDT)=""
+22 SET PEDT=$$FMADD^XLFDT(BEGDT,-1)
SET PRVDT=$EXTRACT(PEDT,1,5)_"00"
SET BQPDAR(PRVDT)=""
+23 SET PRMON=$$FMTE^BQIUL1(PRVDT)
+24 SET PRVN=$ORDER(^BQI(90508,1,19,"B",PRMON,""))
+25 IF PRVN=""
SET PPER="No Previous Period"
QUIT
+26 SET PBGDT=$PIECE(^BQI(90508,1,19,PRVN,0),U,2)
SET PENDT=$PIECE(^BQI(90508,1,19,PRVN,0),U,3)
+27 SET PPER=$$FMTE^BQIUL1(PBGDT)_" - "_$$FMTE^BQIUL1(PENDT)
End DoDot:1
+28 ;
+29 IF TMFRAME=90
Begin DoDot:1
+30 SET CYR=$EXTRACT(BEGDT,1,3)
SET PYR=CYR-1
SET NYR=CYR+1
+31 SET BQMON=$EXTRACT(BEGDT,4,5)
+32 SET BQDTE=$PIECE($TEXT(BQM+BQMON),";;",2)
+33 SET CTMBG=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_"01"
+34 SET CURN=$ORDER(^BQI(90508,1,19,"B",PERIOD,""))
+35 SET EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
+36 SET CTMEN=@($PIECE(BQDTE,U,6))_$PIECE(BQDTE,U,5)_$PIECE(EDAY,U,+$PIECE(BQDTE,U,5))
+37 SET BQCDAR($EXTRACT(CTMBG,1,5)_"00")=""
SET BQCDAR($EXTRACT(CTMEN,1,5)_"00")=""
+38 SET BQCDAR(@($PIECE(BQDTE,U,4))_$PIECE(BQDTE,U,3)_"00")=""
+39 SET CPER=$$FMTE^BQIUL1(CTMBG)_" - "_$$FMTE^BQIUL1(CTMEN)
+40 SET PTMBG=@($PIECE(BQDTE,U,8))_$PIECE(BQDTE,U,7)_"01"
+41 SET PTMEN=@($PIECE(BQDTE,U,12))_$PIECE(BQDTE,U,11)_$PIECE(EDAY,U,+$PIECE(BQDTE,U,1))
+42 SET PRVN=$ORDER(^BQI(90508,1,19,"B",$EXTRACT(PTMBG,1,5)_"00",""))
+43 SET BQPDAR($EXTRACT(PTMBG,1,5)_"00")=""
SET BQPDAR($EXTRACT(PTMEN,1,5)_"00")=""
+44 SET BQPDAR(@($PIECE(BQDTE,U,10))_$PIECE(BQDTE,U,9)_"00")=""
+45 SET PPER=$$FMTE^BQIUL1(PTMBG)_" - "_$$FMTE^BQIUL1(PTMEN)
End DoDot:1
+46 ;
+47 IF TMFRAME=12
Begin DoDot:1
+48 SET CYR=$EXTRACT(BEGDT,1,3)
SET PYR=CYR-1
SET NYR=CYR+1
+49 SET EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
+50 SET BQMON=$EXTRACT(BEGDT,4,5)
+51 SET BQDTE=$PIECE($TEXT(BQM+BQMON),";;",2)
+52 SET CTMBG=BEGDT
+53 SET CTMEN=@($PIECE(BQDTE,U,14))_$PIECE(BQDTE,U,13)_$PIECE(EDAY,U,+$PIECE(BQDTE,U,13))
+54 SET PTMBG=@($PIECE(BQDTE,U,15))_$PIECE(BQDTE,U,1)_"01"
+55 SET PTMEN=@($PIECE(BQDTE,U,16))_$PIECE(BQDTE,U,13)_$PIECE(EDAY,U,+$PIECE(BQDTE,U,13))
+56 SET CPER=$$FMTE^BQIUL1(CTMBG)_" - "_$$FMTE^BQIUL1(CTMEN)
+57 SET PPER=$$FMTE^BQIUL1(PTMBG)_" - "_$$FMTE^BQIUL1(PTMEN)
+58 ;
+59 FOR BM=$PIECE(BQDTE,U,1):1:12
SET TMDT=@($PIECE(BQDTE,U,2))_$SELECT($LENGTH(BM)=1:"0"_BM,1:BM)_"00"
SET BQCDAR(TMDT)=""
+60 FOR BM=1:1:$PIECE(BQDTE,U,13)
SET TMDT=@($PIECE(BQDTE,U,14))_$SELECT($LENGTH(BM)=1:"0"_BM,1:BM)_"00"
SET BQCDAR(TMDT)=""
+61 FOR BM=$PIECE(BQDTE,U,1):1:12
SET TMDT=@($PIECE(BQDTE,U,15))_$SELECT($LENGTH(BM)=1:"0"_BM,1:BM)_"00"
SET BQPDAR(TMDT)=""
+62 FOR BM=1:1:$PIECE(BQDTE,U,13)
SET TMDT=@($PIECE(BQDTE,U,16))_$SELECT($LENGTH(BM)=1:"0"_BM,1:BM)_"00"
SET BQPDAR(TMDT)=""
End DoDot:1
+63 QUIT
+64 ;
BQM ; Period formats
+1 ;;01^CYR^02^CYR^03^CYR^10^PYR^11^PYR^12^PYR^12^CYR^PYR^PYR
+2 ;;02^CYR^03^CYR^04^CYR^11^PYR^12^PYR^01^CYR^01^NYR^PYR^CYR
+3 ;;03^CYR^04^CYR^05^CYR^12^PYR^01^CYR^02^CYR^02^NYR^PYR^CYR
+4 ;;04^CYR^05^CYR^06^CYR^01^CYR^02^CYR^03^CYR^03^NYR^PYR^CYR
+5 ;;05^CYR^06^CYR^07^CYR^02^CYR^03^CYR^04^CYR^04^NYR^PYR^CYR
+6 ;;06^CYR^07^CYR^08^CYR^03^CYR^04^CYR^05^CYR^05^NYR^PYR^CYR
+7 ;;07^CYR^08^CYR^09^CYR^04^CYR^05^CYR^06^CYR^06^NYR^PYR^CYR
+8 ;;08^CYR^09^CYR^10^CYR^05^CYR^06^CYR^07^CYR^07^NYR^PYR^CYR
+9 ;;09^CYR^10^CYR^11^CYR^06^CYR^07^CYR^08^CYR^08^NYR^PYR^CYR
+10 ;;10^CYR^11^CYR^12^CYR^07^CYR^08^CYR^09^CYR^09^NYR^PYR^CYR
+11 ;;11^CYR^12^CYR^01^NYR^08^CYR^09^CYR^10^CYR^10^NYR^PYR^CYR
+12 ;;12^CYR^01^NYR^02^NYR^09^CYR^10^CYR^11^CYR^11^NYR^PYR^CYR
