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)
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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
Q
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
