BQITAXX3 ;PRXM/HC/DB - Determine if User has Taxonomy Access ; 26 May 2006 1:32 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
ACC(DATA,FAKE) ; EP -- BQI GET TAXONOMY ACCESS
; Input
; FAKE - extra 'blank' parameter required by BMXNET async 'feature'
;
; Output
; 1 - User has security key to edit site specific taxonomy
; 0 - User does not have security key to edit site specific taxonomy
;
NEW UID,II,RESULT,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITXACC",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITAXX3 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT"_$C(30)
S RESULT=$$KEYCHK^BQIULSC("BGPZ TAXONOMY EDIT",DUZ)
S II=II+1,@DATA@(II)=RESULT_$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
;
LST(DATA,REG,REP) ; EP -- BQI GET TAX LIST BY REPORT
; Input
; REG - Retrieves taxonomies for a particular registry and
; REP - report
;
; Gets the list of taxonomies defined for iCare
;
NEW UID,II,TIEN,TTXT,BQIH,TAXV,X,RPNM,REPNM,QFL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITXRLST",UID))
K @DATA
;
S REG=$G(REG,""),REP=$G(REP,"")
I REG="" S BMXSEC="RPC Failed: No register selected." Q
I REP="" S BMXSEC="RPC Failed: No report selected." Q
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITAXX D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00030TAXONOMY_NAME^T00003TAX_ITEMS"_$C(30)
;
RGS ; Get taxonomies for register reports
S REG=$O(^BQI(90507,"B",REG,"")) I REG="" G DONE
S REPNM=$G(REP)
S REP=$O(^BQI(90507,REG,20,"B",REPNM,""))
I REP="" S QFL=1 D G DONE:'QFL
. S RPNM=""
. F S RPNM=$O(^BQI(90507,REG,20,"B",RPNM)) Q:RPNM="" D
.. I $$UP^XLFSTR(RPNM)'=REPNM Q
.. S REP=$O(^BQI(90507,REG,20,"B",RPNM,""))
.. I REP="" S QFL=0
;
I REP="" G DONE
;
S TTXT=""
F S TTXT=$O(^BQI(90507,REG,20,REP,10,"B",TTXT)) Q:TTXT="" D
. S TIEN=""
. F S TIEN=$O(^BQI(90507,REG,20,REP,10,"B",TTXT,TIEN)) Q:TIEN="" D
.. NEW DA,IENS
.. S DA(2)=REG,DA(1)=REP,DA=TIEN,IENS=$$IENS^DILF(.DA)
.. S II=II+1
.. S @DATA@(II)=TTXT_"^"_$S($$GET1^DIQ(90507.03,IENS,.02,"I")="":"MIS",$$GET1^DIQ(90507.03,IENS,.03,"I")=1:"YES",'$$ENTRS^BQITAXX($$GET1^DIQ(90507.03,IENS,.02,"I")):"NO",1:"YES")_$C(30)
G DONE
;
TAG(DATA,TAG) ;EP -- BQI GET TAX LIST BY DX CAT
; Input
; TAG - Diagnostic tag
;
; Gets the list of taxonomies defined for iCare
;
NEW UID,II,TIEN,TTXT,BQIH,TAXV,X,RPNM,REPNM,QFL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITXDLST",UID))
K @DATA
;
S TAG=$G(TAG,"")
I TAG'="",TAG'?.N S TAG=$$GDXN^BQITUTL(TAG)
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITAXX D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00030TAXONOMY_NAME^T00020TAX_CATEGORY^T00003TAX_ITEMS^T00003TAX_SITE_DEFINED"_$C(30)
;
;
S TTXT=""
F S TTXT=$O(^BQI(90506.2,"AE",TTXT)) Q:TTXT="" D
. I TAG'="",'$D(^BQI(90506.2,"AE",TTXT,TAG)) Q
. S TXIEN=$O(^BQI(90508,1,10,"B",TTXT,"")) I TXIEN="" Q
. NEW DA,IENS
. S DA(1)=1,DA=TXIEN,IENS=$$IENS^DILF(.DA)
. S II=II+1
. S @DATA@(II)=TTXT_U_$$GET1^DIQ(90508.03,IENS,.03,"E")_U_$S('$$ENTRS^BQITAXX($$GET1^DIQ(90508.03,IENS,.02,"I")):"NO",1:"YES")_U_$S($$GET1^DIQ(90508.03,IENS,.04,"I")=1:"YES",1:"NO")_$C(30)
G DONE
BQITAXX3 ;PRXM/HC/DB - Determine if User has Taxonomy Access ; 26 May 2006 1:32 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
ACC(DATA,FAKE) ; EP -- BQI GET TAXONOMY ACCESS
+1 ; Input
+2 ; FAKE - extra 'blank' parameter required by BMXNET async 'feature'
+3 ;
+4 ; Output
+5 ; 1 - User has security key to edit site specific taxonomy
+6 ; 0 - User does not have security key to edit site specific taxonomy
+7 ;
+8 NEW UID,II,RESULT,X
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BQITXACC",UID))
+11 KILL @DATA
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITAXX3 D UNWIND^%ZTER"
+14 SET @DATA@(II)="I00010RESULT"_$CHAR(30)
+15 SET RESULT=$$KEYCHK^BQIULSC("BGPZ TAXONOMY EDIT",DUZ)
+16 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+17 ;
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 ;
LST(DATA,REG,REP) ; EP -- BQI GET TAX LIST BY REPORT
+1 ; Input
+2 ; REG - Retrieves taxonomies for a particular registry and
+3 ; REP - report
+4 ;
+5 ; Gets the list of taxonomies defined for iCare
+6 ;
+7 NEW UID,II,TIEN,TTXT,BQIH,TAXV,X,RPNM,REPNM,QFL
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BQITXRLST",UID))
+10 KILL @DATA
+11 ;
+12 SET REG=$GET(REG,"")
SET REP=$GET(REP,"")
+13 IF REG=""
SET BMXSEC="RPC Failed: No register selected."
QUIT
+14 IF REP=""
SET BMXSEC="RPC Failed: No report selected."
QUIT
+15 ;
+16 SET II=0
+17 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITAXX D UNWIND^%ZTER"
+18 ;
+19 SET @DATA@(II)="T00030TAXONOMY_NAME^T00003TAX_ITEMS"_$CHAR(30)
+20 ;
RGS ; Get taxonomies for register reports
+1 SET REG=$ORDER(^BQI(90507,"B",REG,""))
IF REG=""
GOTO DONE
+2 SET REPNM=$GET(REP)
+3 SET REP=$ORDER(^BQI(90507,REG,20,"B",REPNM,""))
+4 IF REP=""
SET QFL=1
Begin DoDot:1
+5 SET RPNM=""
+6 FOR
SET RPNM=$ORDER(^BQI(90507,REG,20,"B",RPNM))
IF RPNM=""
QUIT
Begin DoDot:2
+7 IF $$UP^XLFSTR(RPNM)'=REPNM
QUIT
+8 SET REP=$ORDER(^BQI(90507,REG,20,"B",RPNM,""))
+9 IF REP=""
SET QFL=0
End DoDot:2
End DoDot:1
IF 'QFL
GOTO DONE
+10 ;
+11 IF REP=""
GOTO DONE
+12 ;
+13 SET TTXT=""
+14 FOR
SET TTXT=$ORDER(^BQI(90507,REG,20,REP,10,"B",TTXT))
IF TTXT=""
QUIT
Begin DoDot:1
+15 SET TIEN=""
+16 FOR
SET TIEN=$ORDER(^BQI(90507,REG,20,REP,10,"B",TTXT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+17 NEW DA,IENS
+18 SET DA(2)=REG
SET DA(1)=REP
SET DA=TIEN
SET IENS=$$IENS^DILF(.DA)
+19 SET II=II+1
+20 SET @DATA@(II)=TTXT_"^"_$SELECT($$GET1^DIQ(90507.03,IENS,.02,"I")="":"MIS",$$GET1^DIQ(90507.03,IENS,.03,"I")=1:"YES",'$$ENTRS^BQITAXX($$GET1^DIQ(90507.03,IENS,.02,"I")):"NO",1:"YES")_$CHAR(30)
End DoDot:2
End DoDot:1
+21 GOTO DONE
+22 ;
TAG(DATA,TAG) ;EP -- BQI GET TAX LIST BY DX CAT
+1 ; Input
+2 ; TAG - Diagnostic tag
+3 ;
+4 ; Gets the list of taxonomies defined for iCare
+5 ;
+6 NEW UID,II,TIEN,TTXT,BQIH,TAXV,X,RPNM,REPNM,QFL
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQITXDLST",UID))
+9 KILL @DATA
+10 ;
+11 SET TAG=$GET(TAG,"")
+12 IF TAG'=""
IF TAG'?.N
SET TAG=$$GDXN^BQITUTL(TAG)
+13 ;
+14 SET II=0
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITAXX D UNWIND^%ZTER"
+16 ;
+17 SET @DATA@(II)="T00030TAXONOMY_NAME^T00020TAX_CATEGORY^T00003TAX_ITEMS^T00003TAX_SITE_DEFINED"_$CHAR(30)
+18 ;
+19 ;
+20 SET TTXT=""
+21 FOR
SET TTXT=$ORDER(^BQI(90506.2,"AE",TTXT))
IF TTXT=""
QUIT
Begin DoDot:1
+22 IF TAG'=""
IF '$DATA(^BQI(90506.2,"AE",TTXT,TAG))
QUIT
+23 SET TXIEN=$ORDER(^BQI(90508,1,10,"B",TTXT,""))
IF TXIEN=""
QUIT
+24 NEW DA,IENS
+25 SET DA(1)=1
SET DA=TXIEN
SET IENS=$$IENS^DILF(.DA)
+26 SET II=II+1
+27 SET @DATA@(II)=TTXT_U_$$GET1^DIQ(90508.03,IENS,.03,"E")_U_$SELECT('$$ENTRS^BQITAXX($$GET1^DIQ(90508.03,IENS,.02,"I")):"NO",1:"YES")_U_$SELECT($$GET1^DIQ(90508.03,IENS,.04,"I")=1:"YES",1:"NO")_$CHAR(30)
End DoDot:1
+28 GOTO DONE
