BQIMUTIM.m

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