Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQISYPRM

BQISYPRM.m

Go to the documentation of this file. 
  1. BQISYPRM ;VNGT/HS/ALA-ICARE Site Parameters ; 18 Aug 2011  2:09 PM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
  1.  ;
  1.  ;
  1. EN(DATA,FAKE) ; EP -- BQI GET LIST EMPLOYERS
  1.  NEW UID,II,EM
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQISYPRM",UID))
  1.  K @DATA
  1.  S II=0,TYPE=$G(TYPE,"")
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="I00010IEN^T00050"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S EM=""
  1.  F  S EM=$O(^BQI(90508,1,18,"B",EM)) Q:EM=""  D
  1.  . S II=II+1,@DATA@(II)=EM_U_$P($G(^AUTNEMPL(EM,0)),U,1)_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UPD(DATA,PLIST) ; EP -- BQI UPDATE LIST EMPLOYERS
  1.  ;
  1.  NEW RESULT,ERROR,LIST,BN,BQ,PDATA,NAME,VALUE,BI,BQIUPD,EMP
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIUSYPRM",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
  1.  ;
  1.  NEW DA,DIK
  1.  S DA(1)=1,DIK="^BQI(90508,"_DA(1)_",18,",DA=0
  1.  F  S DA=$O(^BQI(90508,DA(1),18,DA)) Q:'DA  D ^DIK
  1.  ;
  1.  S PLIST=$G(PLIST,"")
  1.  I PLIST="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PLIST(BN)) Q:BN=""  S LIST=LIST_PLIST(BN)
  1.  . K PLIST
  1.  . S PLIST=LIST
  1.  . K LIST
  1.  ;
  1.  S RESULT=1
  1.  F BQ=1:1:$L(PLIST,$C(29)) D  Q:$G(BMXSEC)'=""
  1.  . S EMP=$P(PLIST,$C(29),BQ) Q:EMP=""
  1.  . S DA=$O(^BQI(90508,0))
  1.  . I $G(^BQI(90508,DA,18,0))="" S ^BQI(90508,DA,18,0)="^90508.018P^^"
  1.  . S DA(1)=DA,DIC(0)="LNZ",DLAYGO=90508.018,DIC="^BQI(90508,"_DA(1)_",18,"
  1.  . S X=EMP
  1.  . K DO,DD D FILE^DICN
  1.  . I Y=-1 S RESULT=-1
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_U_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GPP(DATA,FAKE) ;EP -- BQI GET PREG PARMS
  1.  NEW UID,II,DA,TYPE,TMFRAME
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQISYGPP",UID))
  1.  K @DATA
  1.  S II=0,TYPE=$G(TYPE,"")
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00030TYPE^T00001TMFRAME"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S TYPE=$$GET1^DIQ(90508,DA_",",16.01,"E")
  1.  S TMFRAME=$$GET1^DIQ(90508,DA_",",16.02,"E")
  1.  S II=II+1,@DATA@(II)=TYPE_U_TMFRAME_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UPGP(DATA,TYPE,TMFRAME) ;EP -- BQI SET PREG PARMS
  1.  NEW RESULT,ERROR,RESULT,BQIUPD,MSG,DA
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIUSYPRM",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
  1.  ;
  1.  S RESULT=1,TYPE=$G(TYPE,""),TMFRAME=$G(TMFRAME,""),MSG=""
  1.  S DA=$$SPM^BQIGPUTL()
  1.  I TYPE'="" S BQIUPD(90508,DA_",",16.01)=TYPE
  1.  I TMFRAME'="" S BQIUPD(90508,DA_",",16.02)=TMFRAME
  1.  I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
  1.  I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  I RESULT=1 D JB^BQITASK4
  1.  Q
  1.  ;
  1. DMA(DATA,FAKE) ;EP -- BQI GET DM AUDIT REGISTER
  1.  NEW UID,II,DA,RIEN,REG
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQISYDMA",UID))
  1.  K @DATA
  1.  S II=0,TYPE=$G(TYPE,"")
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="I00010SUBREG_IEN^T00030REGISTER"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S RIEN=$$GET1^DIQ(90508,DA_",",21.02,"I")
  1.  S REG=$$GET1^DIQ(90508,DA_",",21.02,"E")
  1.  S II=II+1,@DATA@(II)=RIEN_U_REG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UDMA(DATA,SUBREG) ;EP -- BQI SET DM AUDIT REGISTER
  1.  NEW RESULT,ERROR,RESULT,BQIUPD,MSG,DA
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIUDMA",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
  1.  ;
  1.  S RESULT=1,SUBREG=$G(SUBREG,""),MSG=""
  1.  S DA=$$SPM^BQIGPUTL()
  1.  I SUBREG'="" S BQIUPD(90508,DA_",",21.02)=SUBREG
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  I RESULT=1 D JBDM^BQITASK2
  1.  Q
  1.  ;
  1. GORD(DATA,FAKE) ;EP -- BQI GET GRP ORD PARM
  1.  NEW UID,II,DA,GORD
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQISYGPP",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00001GRP_ORD_ENABLED"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S GORD=$$GET1^DIQ(90508,DA_",",.2,"I")
  1.  ; temporary disable of group order
  1.  S GORD=""
  1.  S II=II+1,@DATA@(II)=GORD_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UORD(DATA,ENABLE) ;EP -- BQI SET GRP ORD PARM
  1.  NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIUSYPRM",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
  1.  ;
  1.  S RESULT=1,MSG=""
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S:$G(ENABLE)="" ENABLE="@"
  1.  S BQIUPD(90508,DA_",",.2)=ENABLE
  1.  I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
  1.  I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. INACTT(DATA,TIMEOUT) ;EP -- BQI SET INACTIVE TIMEOUT
  1.  NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIUSYPRM",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
  1.  ;
  1.  S RESULT=1,MSG=""
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S:$G(TIMEOUT)="" TIMEOUT="@"
  1.  S BQIUPD(90508,DA_",",.21)=TIMEOUT
  1.  I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
  1.  I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. WARNT(DATA,TIMEOUT) ;EP -- BQI SET WARNING TIMEOUT
  1.  NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIUSYPRM",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
  1.  ;
  1.  S RESULT=1,MSG=""
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S:$G(TIMEOUT)="" TIMEOUT="@"
  1.  S BQIUPD(90508,DA_",",.22)=TIMEOUT
  1.  I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
  1.  I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. SHUTT(DATA,TIMEOUT) ;EP -- BQI SET SHUTDOWN TIMEOUT
  1.  NEW UID,II,RESULT,DA,BQIUPD,ERROR,MSG
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIUSYPRM",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024ERROR"_$C(30)
  1.  ;
  1.  S RESULT=1,MSG=""
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S:$G(TIMEOUT)="" TIMEOUT="@"
  1.  S BQIUPD(90508,DA_",",.23)=TIMEOUT
  1.  I $D(BQIUPD) D FILE^DIE("E","BQIUPD","ERROR")
  1.  I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GINTT(DATA,FAKE) ;EP -- BQI GET INACTIVE TIMEOUT
  1.  NEW UID,II,DA,GORD
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQISYGPP",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00001INACTIVE_TIMEOUT"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S GORD=$$GET1^DIQ(90508,DA_",",.21,"I")
  1.  S II=II+1,@DATA@(II)=GORD_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GWARNT(DATA,FAKE) ;EP -- BQI GET WARNING TIMEOUT
  1.  NEW UID,II,DA,GORD
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQISYGPP",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00001WARNING_TIMEOUT"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S GORD=$$GET1^DIQ(90508,DA_",",.22,"I")
  1.  S II=II+1,@DATA@(II)=GORD_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GSHUTT(DATA,FAKE) ;EP -- BQI GET SHUTDOWN TIMEOUT
  1.  NEW UID,II,DA,GORD
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQISYGPP",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQISYPRM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00001SHUTDOWN_TIMEOUT"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S DA=$$SPM^BQIGPUTL()
  1.  S GORD=$$GET1^DIQ(90508,DA_",",.23,"I")
  1.  S II=II+1,@DATA@(II)=GORD_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q