BTPWPEVF.m

BTPWPEVF ;GDIT/HC/BEE - CMET Panel Event Filters ; 23 Oct 2012  1:24 PM

 ;;1.0;CARE MANAGEMENT EVENT TRACKING;**3**;Feb 07, 2011;Build 63

 ;

 Q

 ;

FINIT(STATUS,BDT,EDT,CATLST,COMM,PARMS) ;EP - Set up filters based on input parameters

 ;

 ; Input parameters

 ;   PARMS - Delimited list of input variables

 ;             -> STATUS  - Status

 ;             -> TMFRAME - Time frame

 ;             -> CAT     - Category

 ;             -> COMM    - Community

 ;             -> COMMTX  - Community Taxonomy

 ; Output parameters

 ;             -> STATUS  - Status

 ;             -> BDT     - Beginning Date

 ;             -> EDT     - End Date

 ;             -> CATLST     - Category List (Array)

 ;             -> COMM    - Community List (Array)

 ;  

 NEW BQ,TMFRAME,CAT,COMMTX

 ;

 ;Initialize output variables

 S CAT=$G(CAT,""),STATUS=$G(STATUS,""),TMFRAME=$G(TMFRAME,"")

 S COMM=$G(COMM,""),COMMTX=$G(COMMTX,""),BDT=$G(BDT,""),EDT=$G(EDT,"")

 ;

 ;Re-Assemble parameter list if in an array

 S PARMS=$G(PARMS,"")

 I PARMS="" D

 . N LIST,BN

 . S LIST="",BN=""

 . F  S BN=$O(PARMS(BN)) Q:BN=""  S LIST=LIST_PARMS(BN)

 . K PARMS

 . S PARMS=LIST

 . K LIST

 ;

 ;Set up incoming variables

 F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""

 .N PDATA,NAME,VALUE,BP,BV

 .S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""

 .S NAME=$P(PDATA,"=",1) Q:NAME=""

 .S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""

 .F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=@NAME_$S(BP=1:"",1:$C(29))_BV

 ;

 ;Handle blank status

 S:STATUS="" STATUS="P"_$C(29)_"N"_$C(29)_"S"_$C(29)_"T"

 ;

 ;Set up search beginning/end dates

 S (BDT,EDT)=""

 I TMFRAME'="" D

 . I $E(TMFRAME,1)=">" S TMFRAME=$E(TMFRAME,2,99),EDT=$$DATE^BQIUL1(TMFRAME) Q

 . S BDT=$$DATE^BQIUL1(TMFRAME)

 ;

 ;Set up Community Taxonomy

 I COMMTX'="" D

 . N CM,TREF

 . S TREF="COMM" K @TREF

 . D BLD^BQITUTL(COMMTX,TREF)

 . S CM="" F  S CM=$O(COMM(CM)) Q:CM=""  S COMM=$G(COMM)_$S($G(COMM)]"":$C(29),1:"")_CM K COMM(CM)

 ;

 ;Set up Category List Array

 I CAT'="",CAT'=0 D

 . NEW CIN

 . F BQ=1:1:$L(CAT,$C(29)) S CIN=$P(CAT,$C(29),BQ),CATLST(CIN)=""

 ;

 ;Set up Community List Array

 S:'$D(COMM) COMM=""

 I COMM'="",COMM'=0 D

 . NEW CIN

 . F BQ=1:1:$L(COMM,$C(29)) S CIN=+$P(COMM,$C(29),BQ),COMM(CIN)=$P(^AUTTCOM(CIN,0),U,1)

 ;

 Q

 ;

PEFIL(STATUS,BDT,EDT,CATLST,COMM,QIEN) ;EP - Check entry on filters

 ;

 ; Input Parameters

 ; -> STATUS  - Status

 ; -> BDT     - Beginning Date

 ; -> EDT     - End Date

 ; -> CATLST  - Category List (Array)

 ; -> COMM    - Community List (Array)

 ; -> QIEN    - Pointer to CMET EVENT QUEUE (#90629) entry

 ;

 NEW PASS,VDT

 ;

 S STATUS=$G(STATUS,""),BDT=$G(BDT,""),EDT=$G(EDT,"")

 S PASS=1

 ;

 ;Beginning Date Check

 S VDT=$$GET1^DIQ(90629,QIEN_",",.03,"I")

 I BDT]"" D  I 'PASS G XPEFIL

 . I BDT>VDT S PASS=""

 ;

 ;End Date Check

 I EDT]"" D  I 'PASS G XPEFIL

 . I VDT>EDT S PASS=""

 ;

 ;Status Check

 I $TR(STATUS,$C(29))]"" D  I 'PASS G XPEFIL

 . NEW STS

 . S STS=$$GET1^DIQ(90629,QIEN_",",.08,"I")

 . I ($C(29)_STATUS_$C(29))'[($C(29)_STS_$C(29)) S PASS=""

 ;

 ;Category Check

 I $D(CATLST)>9 D  I 'PASS G XPEFIL

 . NEW CAT

 . S CAT=$$GET1^DIQ(90629,QIEN_",",.13,"I") Q:CAT=""

 . I '$D(CATLST(CAT)) S PASS=""

 ;

 ;Community Check

 I $D(COMM)>9 D  I 'PASS G XPEFIL

 . NEW DFN,PCOM

 . S DFN=$$GET1^DIQ(90629,QIEN_",",.02,"I") Q:DFN=""

 . S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I") Q:PCOM=""

 . I '$D(COMM(PCOM)) S PASS=""

 ;

XPEFIL Q PASS

BTPWPEVF  ;GDIT/HC/BEE - CMET Panel Event Filters ; 23 Oct 2012  1:24 PM

 +1       ;;1.0;CARE MANAGEMENT EVENT TRACKING;**3**;Feb 07, 2011;Build 63

 +2       ;

 +3        QUIT 

 +4       ;

FINIT(STATUS,BDT,EDT,CATLST,COMM,PARMS) ;EP - Set up filters based on input parameters

 +1       ;

 +2       ; Input parameters

 +3       ;   PARMS - Delimited list of input variables

 +4       ;             -> STATUS  - Status

 +5       ;             -> TMFRAME - Time frame

 +6       ;             -> CAT     - Category

 +7       ;             -> COMM    - Community

 +8       ;             -> COMMTX  - Community Taxonomy

 +9       ; Output parameters

 +10      ;             -> STATUS  - Status

 +11      ;             -> BDT     - Beginning Date

 +12      ;             -> EDT     - End Date

 +13      ;             -> CATLST     - Category List (Array)

 +14      ;             -> COMM    - Community List (Array)

 +15      ;  

 +16       NEW BQ,TMFRAME,CAT,COMMTX

 +17      ;

 +18      ;Initialize output variables

 +19       SET CAT=$GET(CAT,"")

           SET STATUS=$GET(STATUS,"")

           SET TMFRAME=$GET(TMFRAME,"")

 +20       SET COMM=$GET(COMM,"")

           SET COMMTX=$GET(COMMTX,"")

           SET BDT=$GET(BDT,"")

           SET EDT=$GET(EDT,"")

 +21      ;

 +22      ;Re-Assemble parameter list if in an array

 +23       SET PARMS=$GET(PARMS,"")

 +24       IF PARMS=""

               Begin DoDot:1

 +25               NEW LIST,BN

 +26               SET LIST=""

                   SET BN=""

 +27               FOR 

                       SET BN=$ORDER(PARMS(BN))

                       IF BN=""

                           QUIT 

                       SET LIST=LIST_PARMS(BN)

 +28               KILL PARMS

 +29               SET PARMS=LIST

 +30               KILL LIST

               End DoDot:1

 +31      ;

 +32      ;Set up incoming variables

 +33       FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))

               Begin DoDot:1

 +34               NEW PDATA,NAME,VALUE,BP,BV

 +35               SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)

                   IF PDATA=""

                       QUIT 

 +36               SET NAME=$PIECE(PDATA,"=",1)

                   IF NAME=""

                       QUIT 

 +37               SET VALUE=$PIECE(PDATA,"=",2,99)

                   IF VALUE=""

                       QUIT 

 +38               FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))

                       SET BV=$PIECE(VALUE,$CHAR(29),BP)

                       SET @NAME=@NAME_$SELECT(BP=1:"",1:$CHAR(29))_BV

               End DoDot:1

               IF $GET(BMXSEC)'=""

                   QUIT 

 +39      ;

 +40      ;Handle blank status

 +41       IF STATUS=""

               SET STATUS="P"_$CHAR(29)_"N"_$CHAR(29)_"S"_$CHAR(29)_"T"

 +42      ;

 +43      ;Set up search beginning/end dates

 +44       SET (BDT,EDT)=""

 +45       IF TMFRAME'=""

               Begin DoDot:1

 +46               IF $EXTRACT(TMFRAME,1)=">"

                       SET TMFRAME=$EXTRACT(TMFRAME,2,99)

                       SET EDT=$$DATE^BQIUL1(TMFRAME)

                       QUIT 

 +47               SET BDT=$$DATE^BQIUL1(TMFRAME)

               End DoDot:1

 +48      ;

 +49      ;Set up Community Taxonomy

 +50       IF COMMTX'=""

               Begin DoDot:1

 +51               NEW CM,TREF

 +52               SET TREF="COMM"

                   KILL @TREF

 +53               DO BLD^BQITUTL(COMMTX,TREF)

 +54               SET CM=""

                   FOR 

                       SET CM=$ORDER(COMM(CM))

                       IF CM=""

                           QUIT 

                       SET COMM=$GET(COMM)_$SELECT($GET(COMM)]"":$CHAR(29),1:"")_CM

                       KILL COMM(CM)

               End DoDot:1

 +55      ;

 +56      ;Set up Category List Array

 +57       IF CAT'=""

               IF CAT'=0

                   Begin DoDot:1

 +58                   NEW CIN

 +59                   FOR BQ=1:1:$LENGTH(CAT,$CHAR(29))

                           SET CIN=$PIECE(CAT,$CHAR(29),BQ)

                           SET CATLST(CIN)=""

                   End DoDot:1

 +60      ;

 +61      ;Set up Community List Array

 +62       IF '$DATA(COMM)

               SET COMM=""

 +63       IF COMM'=""

               IF COMM'=0

                   Begin DoDot:1

 +64                   NEW CIN

 +65                   FOR BQ=1:1:$LENGTH(COMM,$CHAR(29))

                           SET CIN=+$PIECE(COMM,$CHAR(29),BQ)

                           SET COMM(CIN)=$PIECE(^AUTTCOM(CIN,0),U,1)

                   End DoDot:1

 +66      ;

 +67       QUIT 

 +68      ;

PEFIL(STATUS,BDT,EDT,CATLST,COMM,QIEN) ;EP - Check entry on filters

 +1       ;

 +2       ; Input Parameters

 +3       ; -> STATUS  - Status

 +4       ; -> BDT     - Beginning Date

 +5       ; -> EDT     - End Date

 +6       ; -> CATLST  - Category List (Array)

 +7       ; -> COMM    - Community List (Array)

 +8       ; -> QIEN    - Pointer to CMET EVENT QUEUE (#90629) entry

 +9       ;

 +10       NEW PASS,VDT

 +11      ;

 +12       SET STATUS=$GET(STATUS,"")

           SET BDT=$GET(BDT,"")

           SET EDT=$GET(EDT,"")

 +13       SET PASS=1

 +14      ;

 +15      ;Beginning Date Check

 +16       SET VDT=$$GET1^DIQ(90629,QIEN_",",.03,"I")

 +17       IF BDT]""

               Begin DoDot:1

 +18               IF BDT>VDT

                       SET PASS=""

               End DoDot:1

               IF 'PASS

                   GOTO XPEFIL

 +19      ;

 +20      ;End Date Check

 +21       IF EDT]""

               Begin DoDot:1

 +22               IF VDT>EDT

                       SET PASS=""

               End DoDot:1

               IF 'PASS

                   GOTO XPEFIL

 +23      ;

 +24      ;Status Check

 +25       IF $TRANSLATE(STATUS,$CHAR(29))]""

               Begin DoDot:1

 +26               NEW STS

 +27               SET STS=$$GET1^DIQ(90629,QIEN_",",.08,"I")

 +28               IF ($CHAR(29)_STATUS_$CHAR(29))'[($CHAR(29)_STS_$CHAR(29))

                       SET PASS=""

               End DoDot:1

               IF 'PASS

                   GOTO XPEFIL

 +29      ;

 +30      ;Category Check

 +31       IF $DATA(CATLST)>9

               Begin DoDot:1

 +32               NEW CAT

 +33               SET CAT=$$GET1^DIQ(90629,QIEN_",",.13,"I")

                   IF CAT=""

                       QUIT 

 +34               IF '$DATA(CATLST(CAT))

                       SET PASS=""

               End DoDot:1

               IF 'PASS

                   GOTO XPEFIL

 +35      ;

 +36      ;Community Check

 +37       IF $DATA(COMM)>9

               Begin DoDot:1

 +38               NEW DFN,PCOM

 +39               SET DFN=$$GET1^DIQ(90629,QIEN_",",.02,"I")

                   IF DFN=""

                       QUIT 

 +40               SET PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")

                   IF PCOM=""

                       QUIT 

 +41               IF '$DATA(COMM(PCOM))

                       SET PASS=""

               End DoDot:1

               IF 'PASS

                   GOTO XPEFIL

 +42      ;

XPEFIL     QUIT PASS