BQITAXX4 ;VNGT/HS/ALA-Update Taxonomy List ; 21 Apr 2009 9:34 AM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
UPD(NTAX,SITE,ID,CAT) ;EP - Update taxonomy list
; Input parameters
; NTAX - Taxonomy name
; SITE - site-populated flag (1)
; ID - Taxonomy ID (DX:DIAGNOSES;M:MEDICATIONS;PR:PROCEDURES;
; T:LAB TESTS;C:CPTS;O:OTHERS;CM:COMMUNITIES
; CAT - Taxonomy category (1:Diagnoses;2:CPT Procedures;
; 3:ICD Procedures;4:Medications;
; 5:Lab Tests;6:Other;7:Communities
;
NEW DA,DIC,X,DLAYGO,IENS,BQIUPD,TIEN,NDA
S TIEN=$O(^ATXAX("B",NTAX,"")) I TIEN="" Q
S DA(1)=$O(^BQI(90508,0)),X=NTAX
S DA=$O(^BQI(90508,DA(1),10,"B",NTAX,""))
I DA="" D
. S DIC(0)="L",DIC="^BQI(90508,"_DA(1)_",10,",DLAYGO=90508.03
. K DO,DD D FILE^DICN
. S DA=+Y
I DA'=-1 S NDA=DA
;I DA=-1 K DO,DD D FILE^DICN S NDA=+Y
S IENS=$$IENS^DILF(.DA)
;
S BQIUPD(90508.03,IENS,.01)=NTAX
D FILE^DIE("E","BQIUPD","ERROR")
;
S BQIUPD(90508.03,IENS,.02)=TIEN_";ATXAX("
S BQIUPD(90508.03,IENS,.03)=$G(CAT)
S BQIUPD(90508.03,IENS,.04)=$G(SITE)
S BQIUPD(90508.03,IENS,.05)=$G(ID)
D FILE^DIE("I","BQIUPD","ERROR")
K BQIUPD
Q
;
ALL ; All taxonomies
; T00030TAXONOMY_NAME^T00015TAXONOMY_IEN^T00020TAX_CATEGORY^T00003TAX_SITE_DEFINED^T00030TAX_ID^T00003TAX_ITEMS^T00030REGISTER^T00003USER_EDITABLE
NEW TXIEN,FILE,CAT,SITE,ID,TAXN,TXN,ITEM,USER
S TXIEN=0
F S TXIEN=$O(^ATXAX(TXIEN)) Q:'TXIEN D
. S FILE=$P($G(^ATXAX(TXIEN,0)),U,15) I FILE="" Q
. S TAXNM=$P(^ATXAX(TXIEN,0),U,1) I TAXNM="" Q
. S TXN=$O(^BQI(90508.4,"B",FILE,""))
. S CAT="",SITE="",ID="",TAXN=TXIEN_";ATXAX("
. D FIN
;
S TXIEN=0
F S TXIEN=$O(^ATXLAB(TXIEN)) Q:'TXIEN D
. S TAXNM=$P(^ATXLAB(TXIEN,0),U,1) I TAXNM="" Q
. S CAT="",SITE="",ID="",TAXN=TXIEN_";ATXLAB(",FILE=60
. S TXN=$O(^BQI(90508.4,"B",FILE,""))
. D FIN
Q
;
FIN ; Finish
I TXN'="" S CN=$P(^BQI(90508.4,TXN,0),U,2),SITE=$P(^BQI(90508.4,TXN,0),U,3)
I $G(CN)'="" S CAT=$P(^BQI(90508.3,CN,0),U,1),ID=$P(^BQI(90508.3,CN,0),U,2)
S ITEM=$S('$$ENTRS^BQITAXX(TAXN):"NO",1:"YES")
S SITE=$S(SITE=1:"YES",1:"NO")
S:CAT="" CAT="OTHER" S:ID="" ID="OTHERS"
S USER=$S(ID="COMMUNITIES":"YES",1:"NO")
I ID="COMMUNITIES" S USER=$S(DUZ=$P(^ATXAX(TXIEN,0),U,5):"YES",1:"NO")
S @SORT@(TAXNM,CAT,ID)=TAXNM_U_TAXN_U_CAT_U_SITE_U_ID_U_ITEM_U_U_USER
;S II=II+1,@DATA@(II)=TAXNM_U_TAXN_U_CAT_U_SITE_U_ID_U_ITEM_U_U_USER_$C(30)
Q
BQITAXX4 ;VNGT/HS/ALA-Update Taxonomy List ; 21 Apr 2009 9:34 AM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
UPD(NTAX,SITE,ID,CAT) ;EP - Update taxonomy list
+1 ; Input parameters
+2 ; NTAX - Taxonomy name
+3 ; SITE - site-populated flag (1)
+4 ; ID - Taxonomy ID (DX:DIAGNOSES;M:MEDICATIONS;PR:PROCEDURES;
+5 ; T:LAB TESTS;C:CPTS;O:OTHERS;CM:COMMUNITIES
+6 ; CAT - Taxonomy category (1:Diagnoses;2:CPT Procedures;
+7 ; 3:ICD Procedures;4:Medications;
+8 ; 5:Lab Tests;6:Other;7:Communities
+9 ;
+10 NEW DA,DIC,X,DLAYGO,IENS,BQIUPD,TIEN,NDA
+11 SET TIEN=$ORDER(^ATXAX("B",NTAX,""))
IF TIEN=""
QUIT
+12 SET DA(1)=$ORDER(^BQI(90508,0))
SET X=NTAX
+13 SET DA=$ORDER(^BQI(90508,DA(1),10,"B",NTAX,""))
+14 IF DA=""
Begin DoDot:1
+15 SET DIC(0)="L"
SET DIC="^BQI(90508,"_DA(1)_",10,"
SET DLAYGO=90508.03
+16 KILL DO,DD
DO FILE^DICN
+17 SET DA=+Y
End DoDot:1
+18 IF DA'=-1
SET NDA=DA
+19 ;I DA=-1 K DO,DD D FILE^DICN S NDA=+Y
+20 SET IENS=$$IENS^DILF(.DA)
+21 ;
+22 SET BQIUPD(90508.03,IENS,.01)=NTAX
+23 DO FILE^DIE("E","BQIUPD","ERROR")
+24 ;
+25 SET BQIUPD(90508.03,IENS,.02)=TIEN_";ATXAX("
+26 SET BQIUPD(90508.03,IENS,.03)=$GET(CAT)
+27 SET BQIUPD(90508.03,IENS,.04)=$GET(SITE)
+28 SET BQIUPD(90508.03,IENS,.05)=$GET(ID)
+29 DO FILE^DIE("I","BQIUPD","ERROR")
+30 KILL BQIUPD
+31 QUIT
+32 ;
ALL ; All taxonomies
+1 ; T00030TAXONOMY_NAME^T00015TAXONOMY_IEN^T00020TAX_CATEGORY^T00003TAX_SITE_DEFINED^T00030TAX_ID^T00003TAX_ITEMS^T00030REGISTER^T00003USER_EDITABLE
+2 NEW TXIEN,FILE,CAT,SITE,ID,TAXN,TXN,ITEM,USER
+3 SET TXIEN=0
+4 FOR
SET TXIEN=$ORDER(^ATXAX(TXIEN))
IF 'TXIEN
QUIT
Begin DoDot:1
+5 SET FILE=$PIECE($GET(^ATXAX(TXIEN,0)),U,15)
IF FILE=""
QUIT
+6 SET TAXNM=$PIECE(^ATXAX(TXIEN,0),U,1)
IF TAXNM=""
QUIT
+7 SET TXN=$ORDER(^BQI(90508.4,"B",FILE,""))
+8 SET CAT=""
SET SITE=""
SET ID=""
SET TAXN=TXIEN_";ATXAX("
+9 DO FIN
End DoDot:1
+10 ;
+11 SET TXIEN=0
+12 FOR
SET TXIEN=$ORDER(^ATXLAB(TXIEN))
IF 'TXIEN
QUIT
Begin DoDot:1
+13 SET TAXNM=$PIECE(^ATXLAB(TXIEN,0),U,1)
IF TAXNM=""
QUIT
+14 SET CAT=""
SET SITE=""
SET ID=""
SET TAXN=TXIEN_";ATXLAB("
SET FILE=60
+15 SET TXN=$ORDER(^BQI(90508.4,"B",FILE,""))
+16 DO FIN
End DoDot:1
+17 QUIT
+18 ;
FIN ; Finish
+1 IF TXN'=""
SET CN=$PIECE(^BQI(90508.4,TXN,0),U,2)
SET SITE=$PIECE(^BQI(90508.4,TXN,0),U,3)
+2 IF $GET(CN)'=""
SET CAT=$PIECE(^BQI(90508.3,CN,0),U,1)
SET ID=$PIECE(^BQI(90508.3,CN,0),U,2)
+3 SET ITEM=$SELECT('$$ENTRS^BQITAXX(TAXN):"NO",1:"YES")
+4 SET SITE=$SELECT(SITE=1:"YES",1:"NO")
+5 IF CAT=""
SET CAT="OTHER"
IF ID=""
SET ID="OTHERS"
+6 SET USER=$SELECT(ID="COMMUNITIES":"YES",1:"NO")
+7 IF ID="COMMUNITIES"
SET USER=$SELECT(DUZ=$PIECE(^ATXAX(TXIEN,0),U,5):"YES",1:"NO")
+8 SET @SORT@(TAXNM,CAT,ID)=TAXNM_U_TAXN_U_CAT_U_SITE_U_ID_U_ITEM_U_U_USER
+9 ;S II=II+1,@DATA@(II)=TAXNM_U_TAXN_U_CAT_U_SITE_U_ID_U_ITEM_U_U_USER_$C(30)
+10 QUIT
