BQISYPRM ;VNGT/HS/ALA-ICARE Site Parameters ; 18 Aug 2011 2:09 PM
;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
;
;
EN(DATA,FAKE) ; EP -- BQI GET LIST EMPLOYERS
NEW UID,II,EM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYPRM",UID))
K @DATA
S II=0,TYPE=$G(TYPE,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="I00010IEN^T00050"
S @DATA@(II)=HDR_$C(30)
S EM=""
F S EM=$O(^BQI(90508,1,18,"B",EM)) Q:EM="" D
. S II=II+1,@DATA@(II)=EM_U_$P($G(^AUTNEMPL(EM,0)),U,1)_$C(30)
;
DONE ;
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
;
UPD(DATA,PLIST) ; EP -- BQI UPDATE LIST EMPLOYERS
;
NEW RESULT,ERROR,LIST,BN,BQ,PDATA,NAME,VALUE,BI,BQIUPD,EMP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUSYPRM",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
;
NEW DA,DIK
S DA(1)=1,DIK="^BQI(90508,"_DA(1)_",18,",DA=0
F S DA=$O(^BQI(90508,DA(1),18,DA)) Q:'DA D ^DIK
;
S PLIST=$G(PLIST,"")
I PLIST="" D
. S LIST="",BN=""
. F S BN=$O(PLIST(BN)) Q:BN="" S LIST=LIST_PLIST(BN)
. K PLIST
. S PLIST=LIST
. K LIST
;
S RESULT=1
F BQ=1:1:$L(PLIST,$C(29)) D Q:$G(BMXSEC)'=""
. S EMP=$P(PLIST,$C(29),BQ) Q:EMP=""
. S DA=$O(^BQI(90508,0))
. I $G(^BQI(90508,DA,18,0))="" S ^BQI(90508,DA,18,0)="^90508.018P^^"
. S DA(1)=DA,DIC(0)="LNZ",DLAYGO=90508.018,DIC="^BQI(90508,"_DA(1)_",18,"
. S X=EMP
. K DO,DD D FILE^DICN
. I Y=-1 S RESULT=-1
;
S II=II+1,@DATA@(II)=RESULT_U_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
GPP(DATA,FAKE) ;EP -- BQI GET PREG PARMS
NEW UID,II,DA,TYPE,TMFRAME
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYGPP",UID))
K @DATA
S II=0,TYPE=$G(TYPE,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00030TYPE^T00001TMFRAME"
S @DATA@(II)=HDR_$C(30)
S DA=$$SPM^BQIGPUTL()
S TYPE=$$GET1^DIQ(90508,DA_",",16.01,"E")
S TMFRAME=$$GET1^DIQ(90508,DA_",",16.02,"E")
S II=II+1,@DATA@(II)=TYPE_U_TMFRAME_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
UPGP(DATA,TYPE,TMFRAME) ;EP -- BQI SET PREG PARMS
NEW RESULT,ERROR,RESULT,BQIUPD,MSG,DA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUSYPRM",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
;
S RESULT=1,TYPE=$G(TYPE,""),TMFRAME=$G(TMFRAME,""),MSG=""
S DA=$$SPM^BQIGPUTL()
I TYPE'="" S BQIUPD(90508,DA_",",16.01)=TYPE
I TMFRAME'="" S BQIUPD(90508,DA_",",16.02)=TMFRAME
I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
;
S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
S II=II+1,@DATA@(II)=$C(31)
I RESULT=1 D JB^BQITASK4
Q
;
DMA(DATA,FAKE) ;EP -- BQI GET DM AUDIT REGISTER
NEW UID,II,DA,RIEN,REG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYDMA",UID))
K @DATA
S II=0,TYPE=$G(TYPE,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="I00010SUBREG_IEN^T00030REGISTER"
S @DATA@(II)=HDR_$C(30)
S DA=$$SPM^BQIGPUTL()
S RIEN=$$GET1^DIQ(90508,DA_",",21.02,"I")
S REG=$$GET1^DIQ(90508,DA_",",21.02,"E")
S II=II+1,@DATA@(II)=RIEN_U_REG_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
UDMA(DATA,SUBREG) ;EP -- BQI SET DM AUDIT REGISTER
NEW RESULT,ERROR,RESULT,BQIUPD,MSG,DA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUDMA",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
;
S RESULT=1,SUBREG=$G(SUBREG,""),MSG=""
S DA=$$SPM^BQIGPUTL()
I SUBREG'="" S BQIUPD(90508,DA_",",21.02)=SUBREG
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
;
S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
S II=II+1,@DATA@(II)=$C(31)
I RESULT=1 D JBDM^BQITASK2
Q
;
GORD(DATA,FAKE) ;EP -- BQI GET GRP ORD PARM
NEW UID,II,DA,GORD
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYGPP",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00001GRP_ORD_ENABLED"
S @DATA@(II)=HDR_$C(30)
S DA=$$SPM^BQIGPUTL()
S GORD=$$GET1^DIQ(90508,DA_",",.2,"I")
; temporary disable of group order
S GORD=""
S II=II+1,@DATA@(II)=GORD_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
UORD(DATA,ENABLE) ;EP -- BQI SET GRP ORD PARM
NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUSYPRM",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
;
S RESULT=1,MSG=""
S DA=$$SPM^BQIGPUTL()
S:$G(ENABLE)="" ENABLE="@"
S BQIUPD(90508,DA_",",.2)=ENABLE
I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
;
S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
INACTT(DATA,TIMEOUT) ;EP -- BQI SET INACTIVE TIMEOUT
NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUSYPRM",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
;
S RESULT=1,MSG=""
S DA=$$SPM^BQIGPUTL()
S:$G(TIMEOUT)="" TIMEOUT="@"
S BQIUPD(90508,DA_",",.21)=TIMEOUT
I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
;
S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
WARNT(DATA,TIMEOUT) ;EP -- BQI SET WARNING TIMEOUT
NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUSYPRM",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
;
S RESULT=1,MSG=""
S DA=$$SPM^BQIGPUTL()
S:$G(TIMEOUT)="" TIMEOUT="@"
S BQIUPD(90508,DA_",",.22)=TIMEOUT
I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
;
S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
SHUTT(DATA,TIMEOUT) ;EP -- BQI SET SHUTDOWN TIMEOUT
NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIUSYPRM",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
;
S RESULT=1,MSG=""
S DA=$$SPM^BQIGPUTL()
S:$G(TIMEOUT)="" TIMEOUT="@"
S BQIUPD(90508,DA_",",.23)=TIMEOUT
I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
;
S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
GINTT(DATA,FAKE) ;EP -- BQI GET INACTIVE TIMEOUT
NEW UID,II,DA,GORD
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYGPP",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00001INACTIVE_TIMEOUT"
S @DATA@(II)=HDR_$C(30)
S DA=$$SPM^BQIGPUTL()
S GORD=$$GET1^DIQ(90508,DA_",",.21,"I")
S II=II+1,@DATA@(II)=GORD_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
GWARNT(DATA,FAKE) ;EP -- BQI GET WARNING TIMEOUT
NEW UID,II,DA,GORD
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYGPP",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00001WARNING_TIMEOUT"
S @DATA@(II)=HDR_$C(30)
S DA=$$SPM^BQIGPUTL()
S GORD=$$GET1^DIQ(90508,DA_",",.22,"I")
S II=II+1,@DATA@(II)=GORD_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
GSHUTT(DATA,FAKE) ;EP -- BQI GET SHUTDOWN TIMEOUT
NEW UID,II,DA,GORD
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQISYGPP",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00001SHUTDOWN_TIMEOUT"
S @DATA@(II)=HDR_$C(30)
S DA=$$SPM^BQIGPUTL()
S GORD=$$GET1^DIQ(90508,DA_",",.23,"I")
S II=II+1,@DATA@(II)=GORD_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
BQISYPRM ;VNGT/HS/ALA-ICARE Site Parameters ; 18 Aug 2011 2:09 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
+2 ;
+3 ;
EN(DATA,FAKE) ; EP -- BQI GET LIST EMPLOYERS
+1 NEW UID,II,EM
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYPRM",UID))
+4 KILL @DATA
+5 SET II=0
SET TYPE=$GET(TYPE,"")
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+7 ;
+8 SET HDR="I00010IEN^T00050"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET EM=""
+11 FOR
SET EM=$ORDER(^BQI(90508,1,18,"B",EM))
IF EM=""
QUIT
Begin DoDot:1
+12 SET II=II+1
SET @DATA@(II)=EM_U_$PIECE($GET(^AUTNEMPL(EM,0)),U,1)_$CHAR(30)
End DoDot:1
+13 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
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 ;
UPD(DATA,PLIST) ; EP -- BQI UPDATE LIST EMPLOYERS
+1 ;
+2 NEW RESULT,ERROR,LIST,BN,BQ,PDATA,NAME,VALUE,BI,BQIUPD,EMP
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIUSYPRM",UID))
+5 KILL @DATA
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+9 SET @DATA@(II)="I00010RESULT^T01024ERROR"_$CHAR(30)
+10 ;
+11 NEW DA,DIK
+12 SET DA(1)=1
SET DIK="^BQI(90508,"_DA(1)_",18,"
SET DA=0
+13 FOR
SET DA=$ORDER(^BQI(90508,DA(1),18,DA))
IF 'DA
QUIT
DO ^DIK
+14 ;
+15 SET PLIST=$GET(PLIST,"")
+16 IF PLIST=""
Begin DoDot:1
+17 SET LIST=""
SET BN=""
+18 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+19 KILL PLIST
+20 SET PLIST=LIST
+21 KILL LIST
End DoDot:1
+22 ;
+23 SET RESULT=1
+24 FOR BQ=1:1:$LENGTH(PLIST,$CHAR(29))
Begin DoDot:1
+25 SET EMP=$PIECE(PLIST,$CHAR(29),BQ)
IF EMP=""
QUIT
+26 SET DA=$ORDER(^BQI(90508,0))
+27 IF $GET(^BQI(90508,DA,18,0))=""
SET ^BQI(90508,DA,18,0)="^90508.018P^^"
+28 SET DA(1)=DA
SET DIC(0)="LNZ"
SET DLAYGO=90508.018
SET DIC="^BQI(90508,"_DA(1)_",18,"
+29 SET X=EMP
+30 KILL DO,DD
DO FILE^DICN
+31 IF Y=-1
SET RESULT=-1
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+32 ;
+33 SET II=II+1
SET @DATA@(II)=RESULT_U_$CHAR(30)
+34 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+35 QUIT
+36 ;
GPP(DATA,FAKE) ;EP -- BQI GET PREG PARMS
+1 NEW UID,II,DA,TYPE,TMFRAME
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYGPP",UID))
+4 KILL @DATA
+5 SET II=0
SET TYPE=$GET(TYPE,"")
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+7 ;
+8 SET HDR="T00030TYPE^T00001TMFRAME"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET DA=$$SPM^BQIGPUTL()
+11 SET TYPE=$$GET1^DIQ(90508,DA_",",16.01,"E")
+12 SET TMFRAME=$$GET1^DIQ(90508,DA_",",16.02,"E")
+13 SET II=II+1
SET @DATA@(II)=TYPE_U_TMFRAME_$CHAR(30)
+14 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+15 QUIT
+16 ;
UPGP(DATA,TYPE,TMFRAME) ;EP -- BQI SET PREG PARMS
+1 NEW RESULT,ERROR,RESULT,BQIUPD,MSG,DA
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIUSYPRM",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+8 SET @DATA@(II)="I00010RESULT^T01024ERROR"_$CHAR(30)
+9 ;
+10 SET RESULT=1
SET TYPE=$GET(TYPE,"")
SET TMFRAME=$GET(TMFRAME,"")
SET MSG=""
+11 SET DA=$$SPM^BQIGPUTL()
+12 IF TYPE'=""
SET BQIUPD(90508,DA_",",16.01)=TYPE
+13 IF TMFRAME'=""
SET BQIUPD(90508,DA_",",16.02)=TMFRAME
+14 IF $DATA(BQIUPD)
DO FILE^DIE("E","BQIUPD","ERROR")
+15 IF $DATA(ERROR)
SET RESULT=-1
SET MSG=$GET(ERROR("DIERR",1,"TEXT",1))
+16 ;
+17 SET II=II+1
SET @DATA@(II)=RESULT_U_MSG_$CHAR(30)
+18 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+19 IF RESULT=1
DO JB^BQITASK4
+20 QUIT
+21 ;
DMA(DATA,FAKE) ;EP -- BQI GET DM AUDIT REGISTER
+1 NEW UID,II,DA,RIEN,REG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYDMA",UID))
+4 KILL @DATA
+5 SET II=0
SET TYPE=$GET(TYPE,"")
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+7 ;
+8 SET HDR="I00010SUBREG_IEN^T00030REGISTER"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET DA=$$SPM^BQIGPUTL()
+11 SET RIEN=$$GET1^DIQ(90508,DA_",",21.02,"I")
+12 SET REG=$$GET1^DIQ(90508,DA_",",21.02,"E")
+13 SET II=II+1
SET @DATA@(II)=RIEN_U_REG_$CHAR(30)
+14 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+15 QUIT
+16 ;
UDMA(DATA,SUBREG) ;EP -- BQI SET DM AUDIT REGISTER
+1 NEW RESULT,ERROR,RESULT,BQIUPD,MSG,DA
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIUDMA",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+8 SET @DATA@(II)="I00010RESULT^T01024ERROR"_$CHAR(30)
+9 ;
+10 SET RESULT=1
SET SUBREG=$GET(SUBREG,"")
SET MSG=""
+11 SET DA=$$SPM^BQIGPUTL()
+12 IF SUBREG'=""
SET BQIUPD(90508,DA_",",21.02)=SUBREG
+13 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+14 IF $DATA(ERROR)
SET RESULT=-1
SET MSG=$GET(ERROR("DIERR",1,"TEXT",1))
+15 ;
+16 SET II=II+1
SET @DATA@(II)=RESULT_U_MSG_$CHAR(30)
+17 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+18 IF RESULT=1
DO JBDM^BQITASK2
+19 QUIT
+20 ;
GORD(DATA,FAKE) ;EP -- BQI GET GRP ORD PARM
+1 NEW UID,II,DA,GORD
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYGPP",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+7 ;
+8 SET HDR="T00001GRP_ORD_ENABLED"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET DA=$$SPM^BQIGPUTL()
+11 SET GORD=$$GET1^DIQ(90508,DA_",",.2,"I")
+12 ; temporary disable of group order
+13 SET GORD=""
+14 SET II=II+1
SET @DATA@(II)=GORD_$CHAR(30)
+15 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+16 QUIT
+17 ;
UORD(DATA,ENABLE) ;EP -- BQI SET GRP ORD PARM
+1 NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIUSYPRM",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+8 SET @DATA@(II)="I00010RESULT^T01024ERROR"_$CHAR(30)
+9 ;
+10 SET RESULT=1
SET MSG=""
+11 SET DA=$$SPM^BQIGPUTL()
+12 IF $GET(ENABLE)=""
SET ENABLE="@"
+13 SET BQIUPD(90508,DA_",",.2)=ENABLE
+14 IF $DATA(BQIUPD)
DO FILE^DIE("E","BQIUPD","ERROR")
+15 IF $DATA(ERROR)
SET RESULT=-1
SET MSG=$GET(ERROR("DIERR",1,"TEXT",1))
+16 ;
+17 SET II=II+1
SET @DATA@(II)=RESULT_U_MSG_$CHAR(30)
+18 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+19 QUIT
+20 ;
INACTT(DATA,TIMEOUT) ;EP -- BQI SET INACTIVE TIMEOUT
+1 NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIUSYPRM",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+8 SET @DATA@(II)="I00010RESULT^T01024ERROR"_$CHAR(30)
+9 ;
+10 SET RESULT=1
SET MSG=""
+11 SET DA=$$SPM^BQIGPUTL()
+12 IF $GET(TIMEOUT)=""
SET TIMEOUT="@"
+13 SET BQIUPD(90508,DA_",",.21)=TIMEOUT
+14 IF $DATA(BQIUPD)
DO FILE^DIE("E","BQIUPD","ERROR")
+15 IF $DATA(ERROR)
SET RESULT=-1
SET MSG=$GET(ERROR("DIERR",1,"TEXT",1))
+16 ;
+17 SET II=II+1
SET @DATA@(II)=RESULT_U_MSG_$CHAR(30)
+18 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+19 QUIT
+20 ;
WARNT(DATA,TIMEOUT) ;EP -- BQI SET WARNING TIMEOUT
+1 NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIUSYPRM",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+8 SET @DATA@(II)="I00010RESULT^T01024ERROR"_$CHAR(30)
+9 ;
+10 SET RESULT=1
SET MSG=""
+11 SET DA=$$SPM^BQIGPUTL()
+12 IF $GET(TIMEOUT)=""
SET TIMEOUT="@"
+13 SET BQIUPD(90508,DA_",",.22)=TIMEOUT
+14 IF $DATA(BQIUPD)
DO FILE^DIE("E","BQIUPD","ERROR")
+15 IF $DATA(ERROR)
SET RESULT=-1
SET MSG=$GET(ERROR("DIERR",1,"TEXT",1))
+16 ;
+17 SET II=II+1
SET @DATA@(II)=RESULT_U_MSG_$CHAR(30)
+18 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+19 QUIT
+20 ;
SHUTT(DATA,TIMEOUT) ;EP -- BQI SET SHUTDOWN TIMEOUT
+1 NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIUSYPRM",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+8 SET @DATA@(II)="I00010RESULT^T01024ERROR"_$CHAR(30)
+9 ;
+10 SET RESULT=1
SET MSG=""
+11 SET DA=$$SPM^BQIGPUTL()
+12 IF $GET(TIMEOUT)=""
SET TIMEOUT="@"
+13 SET BQIUPD(90508,DA_",",.23)=TIMEOUT
+14 IF $DATA(BQIUPD)
DO FILE^DIE("E","BQIUPD","ERROR")
+15 IF $DATA(ERROR)
SET RESULT=-1
SET MSG=$GET(ERROR("DIERR",1,"TEXT",1))
+16 ;
+17 SET II=II+1
SET @DATA@(II)=RESULT_U_MSG_$CHAR(30)
+18 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+19 QUIT
+20 ;
GINTT(DATA,FAKE) ;EP -- BQI GET INACTIVE TIMEOUT
+1 NEW UID,II,DA,GORD
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYGPP",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+7 ;
+8 SET HDR="T00001INACTIVE_TIMEOUT"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET DA=$$SPM^BQIGPUTL()
+11 SET GORD=$$GET1^DIQ(90508,DA_",",.21,"I")
+12 SET II=II+1
SET @DATA@(II)=GORD_$CHAR(30)
+13 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+14 QUIT
+15 ;
GWARNT(DATA,FAKE) ;EP -- BQI GET WARNING TIMEOUT
+1 NEW UID,II,DA,GORD
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYGPP",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+7 ;
+8 SET HDR="T00001WARNING_TIMEOUT"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET DA=$$SPM^BQIGPUTL()
+11 SET GORD=$$GET1^DIQ(90508,DA_",",.22,"I")
+12 SET II=II+1
SET @DATA@(II)=GORD_$CHAR(30)
+13 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+14 QUIT
+15 ;
GSHUTT(DATA,FAKE) ;EP -- BQI GET SHUTDOWN TIMEOUT
+1 NEW UID,II,DA,GORD
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQISYGPP",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER"
+7 ;
+8 SET HDR="T00001SHUTDOWN_TIMEOUT"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET DA=$$SPM^BQIGPUTL()
+11 SET GORD=$$GET1^DIQ(90508,DA_",",.23,"I")
+12 SET II=II+1
SET @DATA@(II)=GORD_$CHAR(30)
+13 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+14 QUIT
