- 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
