Routine: BQIMUSIT

BQIMUSIT ;VNGT/HS/ALA-MU Site Parameters ; 03 Mar 2011  3:13 PM

 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

GUSR(DATA,FAKE) ;EP -- BQI MU GET SITE PARAMETERS

 ; Get specific MU system parameters from the Site Parameter file

 NEW UID,II,IEN,CLASS,CN,CLSN,DTE,DATE,CLS,CDTE,CDATE

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIMUSIT",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUSIT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 S @DATA@(II)="T00010TIMEFRAME^T00010CQTIMEFRAME^T00001TYPE^T01024USER_CLASSES"_$C(30)

 S IEN=$O(^BQI(90508,0)) I IEN="" S BMXSEC="No site defined" Q

 S CLASS="",CN=0

 F  S CN=$O(^BQI(90508,IEN,13,CN)) Q:'CN  D

 . S CLSN=$P(^BQI(90508,IEN,13,CN,0),U,1)

 . S CLASS=CLASS_CLSN_$C(28)_$P(^USR(8930,CLSN,0),U,4)_$C(29)

 . S DTE=$$GET1^DIQ(90508,IEN_",",12.01,"I") I DTE="" S DATE="90"_$C(28)_"90 Days"

 . I DTE'="" S DATE=DTE_$C(28)_$$GET1^DIQ(90508,IEN_",",12.01,"E")

 . S CDTE=$$GET1^DIQ(90508,IEN_",",12.1,"I") I CDTE="" S CDATE="90"_$C(28)_"90 Days"

 . I CDTE'="" S CDATE=CDTE_$C(28)_$$GET1^DIQ(90508,IEN_",",12.1,"E")

 . S CLS=$$GET1^DIQ(90508,IEN_",",12.02,"I")

 S II=II+1,@DATA@(II)=DATE_U_CDATE_U_CLS_U_$$TKO^BQIUL1(CLASS,$C(29))_$C(30)

 S II=II+1,@DATA@(II)=$C(31)

UUSR(DATA,PARMS) ;EP -- BQI MU UPDATE SITE PARAMETERS

 NEW RESULT,ERROR,LIST,BN,BQ,PDATA,NAME,VALUE,CLASS,BI,CDATA,BQIUPD

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIUUSR",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUSIT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 S @DATA@(II)="I00010RESULT^T001024ERROR"_$C(30)

 S PARMS=$G(PARMS,"")

 I PARMS="" D

 . S LIST="",BN=""

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

 . K PARMS

 . S PARMS=LIST

 . K LIST

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

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

 . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)

 . I NAME="TIMEFRAME" S BQIUPD(90508,1_",",12.01)=VALUE Q

 . I NAME="CQTIMEFRAME" S BQIUPD(90508,1_",",12.1)=VALUE Q

 . I NAME="TYPE" S BQIUPD(90508,1_",",12.02)=$S(VALUE="Y":VALUE,1:"@") Q

 . I NAME="CLASS" F BI=1:1:$L(VALUE,$C(29)) D

 .. S CDATA=$P(VALUE,$C(29),BI),CLASS(CDATA)=""

 S RESULT=1

 I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")

 I $D(CLASS) D

 . I $G(^BQI(90508,1,13,0))="" S ^BQI(90508,1,13,0)="^90508.013P^^"

 . NEW DA,DIK

 . S DA(1)=1,DA=0,DIK="^BQI(90508,"_DA(1)_",13,"

 . F  S DA=$O(^BQI(90508,DA(1),13,DA)) Q:'DA  D ^DIK

 . S DA(1)=1

 . S CLS="",DIC(0)="LMNZ",DLAYGO="90508.13",DIC("P")=DLAYGO,DIC="^BQI(90508,"_DA(1)_",13,"

 . F  S CLS=$O(CLASS(CLS)) Q:CLS=""  S X="`"_CLS D ^DIC I Y=-1 S RESULT=-1

 I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))

 I $P(RESULT,U,1)'=-1 S RESULT=1_U

 S II=II+1,@DATA@(II)=RESULT_$C(30)

 S II=II+1,@DATA@(II)=$C(31)

ERR ;

 D ^%ZTER

 NEW Y,ERRDTM

 S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y

 S BMXSEC="Recording that an error occurred at "_ERRDTM

 I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)

ACT(DATA,FAKE) ;EP -- BQI GET NUMBER OF PATIENTS

 NEW II,UID,VALUE

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPTACT",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUSIT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 S @DATA@(II)="I00010TOTAL^I00010ACTIVE^I00010NOTSEEN"_$C(30)

 S VALUE=$G(^XTMP("BQIPTACT",1))

 I VALUE="" D NUM S VALUE=$G(^XTMP("BQIPTACT",1))

 S II=II+1,@DATA@(II)=VALUE_$C(30)

 S II=II+1,@DATA@(II)=$C(31)

NUM ;EP

 NEW TOT,ACT,NOT,DFN

 S TOT=0,ACT=0,NOT=0

 S DFN=0

 F  S DFN=$O(^AUPNPAT(DFN)) Q:'DFN  D

 . I $G(^AUPNPAT(DFN,0))="" Q

 . S TOT=TOT+1

 . I $$HRN^BQIUL1(DFN) S ACT=ACT+1

 . I '$$VTHR^BQIUL1(DFN) S NOT=NOT+1

 S ^XTMP("BQIPTACT",0)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"Count of Patients"

 S ^XTMP("BQIPTACT",1)=TOT_U_ACT_U_NOT

BQIMUSIT  ;VNGT/HS/ALA-MU Site Parameters ; 03 Mar 2011  3:13 PM

 +1       ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 +2       ;

 +3       ;

GUSR(DATA,FAKE) ;EP -- BQI MU GET SITE PARAMETERS

 +1       ;

 +2       ; Get specific MU system parameters from the Site Parameter file

 +3        NEW UID,II,IEN,CLASS,CN,CLSN,DTE,DATE,CLS,CDTE,CDATE

 +4        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +5        SET DATA=$NAME(^TMP("BQIMUSIT",UID))

 +6        KILL @DATA

 +7       ;

 +8        SET II=0

 +9       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIMUSIT D UNWIND^%ZTER"

 +10      ;

 +11       SET @DATA@(II)="T00010TIMEFRAME^T00010CQTIMEFRAME^T00001TYPE^T01024USER_CLASSES"_$CHAR(30)

 +12      ;

 +13       SET IEN=$ORDER(^BQI(90508,0))

           IF IEN=""

               SET BMXSEC="No site defined"

               QUIT

 +14       SET CLASS=""

           SET CN=0

 +15       FOR

               SET CN=$ORDER(^BQI(90508,IEN,13,CN))

               IF 'CN

                   QUIT

               Begin DoDot:1

 +16               SET CLSN=$PIECE(^BQI(90508,IEN,13,CN,0),U,1)

 +17               SET CLASS=CLASS_CLSN_$CHAR(28)_$PIECE(^USR(8930,CLSN,0),U,4)_$CHAR(29)

 +18               SET DTE=$$GET1^DIQ(90508,IEN_",",12.01,"I")

                   IF DTE=""

                       SET DATE="90"_$CHAR(28)_"90 Days"

 +19               IF DTE'=""

                       SET DATE=DTE_$CHAR(28)_$$GET1^DIQ(90508,IEN_",",12.01,"E")

 +20               SET CDTE=$$GET1^DIQ(90508,IEN_",",12.1,"I")

                   IF CDTE=""

                       SET CDATE="90"_$CHAR(28)_"90 Days"

 +21               IF CDTE'=""

                       SET CDATE=CDTE_$CHAR(28)_$$GET1^DIQ(90508,IEN_",",12.1,"E")

 +22               SET CLS=$$GET1^DIQ(90508,IEN_",",12.02,"I")

               End DoDot:1

 +23       SET II=II+1

           SET @DATA@(II)=DATE_U_CDATE_U_CLS_U_$$TKO^BQIUL1(CLASS,$CHAR(29))_$CHAR(30)

 +24      ;

 +25       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +26       QUIT

 +27      ;

UUSR(DATA,PARMS) ;EP -- BQI MU UPDATE SITE PARAMETERS

 +1        NEW RESULT,ERROR,LIST,BN,BQ,PDATA,NAME,VALUE,CLASS,BI,CDATA,BQIUPD

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("BQIUUSR",UID))

 +4        KILL @DATA

 +5       ;

 +6        SET II=0

 +7       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIMUSIT D UNWIND^%ZTER"

 +8        SET @DATA@(II)="I00010RESULT^T001024ERROR"_$CHAR(30)

 +9       ;

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

 +11       IF PARMS=""

               Begin DoDot:1

 +12               SET LIST=""

                   SET BN=""

 +13               FOR

                       SET BN=$ORDER(PARMS(BN))

                       IF BN=""

                           QUIT

                       SET LIST=LIST_PARMS(BN)

 +14               KILL PARMS

 +15               SET PARMS=LIST

 +16               KILL LIST

               End DoDot:1

 +17      ;

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

               Begin DoDot:1

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

                   IF PDATA=""

                       QUIT

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

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

 +21               IF NAME="TIMEFRAME"

                       SET BQIUPD(90508,1_",",12.01)=VALUE

                       QUIT

 +22               IF NAME="CQTIMEFRAME"

                       SET BQIUPD(90508,1_",",12.1)=VALUE

                       QUIT

 +23               IF NAME="TYPE"

                       SET BQIUPD(90508,1_",",12.02)=$SELECT(VALUE="Y":VALUE,1:"@")

                       QUIT

 +24               IF NAME="CLASS"

                       FOR BI=1:1:$LENGTH(VALUE,$CHAR(29))

                           Begin DoDot:2

 +25                           SET CDATA=$PIECE(VALUE,$CHAR(29),BI)

                               SET CLASS(CDATA)=""

                           End DoDot:2

               End DoDot:1

               IF $GET(BMXSEC)'=""

                   QUIT

 +26      ;

 +27       SET RESULT=1

 +28       IF $DATA(BQIUPD)

               DO FILE^DIE("","BQIUPD","ERROR")

 +29       IF $DATA(CLASS)

               Begin DoDot:1

 +30               IF $GET(^BQI(90508,1,13,0))=""

                       SET ^BQI(90508,1,13,0)="^90508.013P^^"

 +31               NEW DA,DIK

 +32               SET DA(1)=1

                   SET DA=0

                   SET DIK="^BQI(90508,"_DA(1)_",13,"

 +33               FOR

                       SET DA=$ORDER(^BQI(90508,DA(1),13,DA))

                       IF 'DA

                           QUIT

                       DO ^DIK

 +34               SET DA(1)=1

 +35               SET CLS=""

                   SET DIC(0)="LMNZ"

                   SET DLAYGO="90508.13"

                   SET DIC("P")=DLAYGO

                   SET DIC="^BQI(90508,"_DA(1)_",13,"

 +36               FOR

                       SET CLS=$ORDER(CLASS(CLS))

                       IF CLS=""

                           QUIT

                       SET X="`"_CLS

                       DO ^DIC

                       IF Y=-1

                           SET RESULT=-1

               End DoDot:1

 +37      ;

 +38       IF $DATA(ERROR)>0

               SET RESULT=-1_U_$GET(ERROR("DIERR",1,"TEXT",1))

 +39       IF $PIECE(RESULT,U,1)'=-1

               SET RESULT=1_U

 +40       SET II=II+1

           SET @DATA@(II)=RESULT_$CHAR(30)

 +41       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +42       QUIT

 +43      ;

ERR       ;

 +1        DO ^%ZTER

 +2        NEW Y,ERRDTM

 +3        SET Y=$$NOW^XLFDT()

           XECUTE ^DD("DD")

           SET ERRDTM=Y

 +4        SET BMXSEC="Recording that an error occurred at "_ERRDTM

 +5        IF $DATA(II)

               IF $DATA(DATA)

                   SET II=II+1

                   SET @DATA@(II)=$CHAR(31)

 +6        QUIT

 +7       ;

ACT(DATA,FAKE) ;EP -- BQI GET NUMBER OF PATIENTS

 +1        NEW II,UID,VALUE

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("BQIPTACT",UID))

 +4        KILL @DATA

 +5       ;

 +6        SET II=0

 +7       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIMUSIT D UNWIND^%ZTER"

 +8        SET @DATA@(II)="I00010TOTAL^I00010ACTIVE^I00010NOTSEEN"_$CHAR(30)

 +9        SET VALUE=$GET(^XTMP("BQIPTACT",1))

 +10       IF VALUE=""

               DO NUM

               SET VALUE=$GET(^XTMP("BQIPTACT",1))

 +11       SET II=II+1

           SET @DATA@(II)=VALUE_$CHAR(30)

 +12       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +13       QUIT

 +14      ;

NUM       ;EP

 +1        NEW TOT,ACT,NOT,DFN

 +2        SET TOT=0

           SET ACT=0

           SET NOT=0

 +3        SET DFN=0

 +4        FOR

               SET DFN=$ORDER(^AUPNPAT(DFN))

               IF 'DFN

                   QUIT

               Begin DoDot:1

 +5                IF $GET(^AUPNPAT(DFN,0))=""

                       QUIT

 +6                SET TOT=TOT+1

 +7                IF $$HRN^BQIUL1(DFN)

                       SET ACT=ACT+1

 +8                IF '$$VTHR^BQIUL1(DFN)

                       SET NOT=NOT+1

               End DoDot:1

 +9        SET ^XTMP("BQIPTACT",0)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"Count of Patients"

 +10       SET ^XTMP("BQIPTACT",1)=TOT_U_ACT_U_NOT

 +11       QUIT

BQIMUSIT.m