BSTSDTSC.m

BSTSDTSC ;GDIT/HS/BEE-Standard Terminology DTS Calls/Processing ; 5 Nov 2012  9:53 AM

 ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62

 ;

 Q

 ;

CLEAR(DTSNODE,NMID) ;EP - Clear out Custom Codeset Entries

 ;

 NEW DTSID,CONCEPT,DIEN,CIEN,TIEN,DA,DIK

 ;

 I $G(NMID)="" Q

 ;

 S DTSID=$P(DTSNODE,U) Q:DTSID=""

 S CONCEPT=$P(DTSNODE,U,2) Q:CONCEPT=""

 ;

 ;Look up the concepts pointed to (may be different)

 S DIEN=$O(^BSTS(9002318.4,"D",NMID,DTSID,""))

 S CIEN=$O(^BSTS(9002318.4,"C",NMID,CONCEPT,""))

 I CIEN=DIEN Q

 ;

 ;IENS are different so we need to get rid of both of them

 ;

 ;Get rid of the terms

 I DIEN]"" S TIEN="" F  S TIEN=$O(^BSTS(9002318.3,"C",NMID,DIEN,TIEN)) Q:TIEN=""  D

 . NEW DA,DIK

 . ;

 . S DA=TIEN,DIK="^BSTS(9002318.3," D ^DIK

 ;

 I CIEN]"" S TIEN="" F  S TIEN=$O(^BSTS(9002318.3,"C",NMID,CIEN,TIEN)) Q:TIEN=""  D

 . NEW DA,DIK

 . ;

 . S DA=TIEN,DIK="^BSTS(9002318.3," D ^DIK

 ;

 ;Get rid of the concepts

 I CIEN]"" S DA=CIEN,DIK="^BSTS(9002318.4," D ^DIK

 I DIEN]"" S DA=DIEN,DIK="^BSTS(9002318.4," D ^DIK

 ;

 Q

BSTSDTSC  ;GDIT/HS/BEE-Standard Terminology DTS Calls/Processing ; 5 Nov 2012  9:53 AM

 +1       ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62

 +2       ;

 +3        QUIT 

 +4       ;

CLEAR(DTSNODE,NMID) ;EP - Clear out Custom Codeset Entries

 +1       ;

 +2        NEW DTSID,CONCEPT,DIEN,CIEN,TIEN,DA,DIK

 +3       ;

 +4        IF $GET(NMID)=""

               QUIT 

 +5       ;

 +6        SET DTSID=$PIECE(DTSNODE,U)

           IF DTSID=""

               QUIT 

 +7        SET CONCEPT=$PIECE(DTSNODE,U,2)

           IF CONCEPT=""

               QUIT 

 +8       ;

 +9       ;Look up the concepts pointed to (may be different)

 +10       SET DIEN=$ORDER(^BSTS(9002318.4,"D",NMID,DTSID,""))

 +11       SET CIEN=$ORDER(^BSTS(9002318.4,"C",NMID,CONCEPT,""))

 +12       IF CIEN=DIEN

               QUIT 

 +13      ;

 +14      ;IENS are different so we need to get rid of both of them

 +15      ;

 +16      ;Get rid of the terms

 +17       IF DIEN]""

               SET TIEN=""

               FOR 

                   SET TIEN=$ORDER(^BSTS(9002318.3,"C",NMID,DIEN,TIEN))

                   IF TIEN=""

                       QUIT 

                   Begin DoDot:1

 +18                   NEW DA,DIK

 +19      ;

 +20                   SET DA=TIEN

                       SET DIK="^BSTS(9002318.3,"

                       DO ^DIK

                   End DoDot:1

 +21      ;

 +22       IF CIEN]""

               SET TIEN=""

               FOR 

                   SET TIEN=$ORDER(^BSTS(9002318.3,"C",NMID,CIEN,TIEN))

                   IF TIEN=""

                       QUIT 

                   Begin DoDot:1

 +23                   NEW DA,DIK

 +24      ;

 +25                   SET DA=TIEN

                       SET DIK="^BSTS(9002318.3,"

                       DO ^DIK

                   End DoDot:1

 +26      ;

 +27      ;Get rid of the concepts

 +28       IF CIEN]""

               SET DA=CIEN

               SET DIK="^BSTS(9002318.4,"

               DO ^DIK

 +29       IF DIEN]""

               SET DA=DIEN

               SET DIK="^BSTS(9002318.4,"

               DO ^DIK

 +30      ;

 +31       QUIT