PXRMTXCS.m

PXRMTXCS ; SLC/PKR - Taxonomy code search routines. ;07/24/2013

 ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404

 ;

 ;=====================================================

CSEARCH(CODESYS,CODE,NFOUND,TAXLIST) ; Search all taxonomies to see if they

 ;contain CODE.

 N IEN,NAME

 K TAXLIST

 S NFOUND=0,NAME=""

 F  S NAME=$O(^PXD(811.2,"B",NAME)) Q:NAME=""  D

 . S IEN=$O(^PXD(811.2,"B",NAME,""))

 . I $D(^PXD(811.2,IEN,20,"AE",CODESYS,CODE)) S NFOUND=NFOUND+1,TAXLIST(NAME)=""

 Q

 ;

 ;=====================================================

SEARCH ; Let the user input a code then search all taxonomies to determine

 ;which ones include that code.

 N CODE,CODESYS,CODESYSL,CODESYSP,DATA,DIR,DIRUT,DTOUT,DUOUT,NFOUND

 N TAX,TAXLIST,RESULT,VALID,Y

 D CODESYSL^PXRMLEX(.CODESYSL)

 S DIR(0)="FAOU"

 S DIR("A")="Input a code to search for: "

GCODE W !

 D ^DIR

 I $D(DIRUT) Q

 S CODE=Y

 ;See if this is a valid code.

 S VALID=$$VCODE^PXRMLEX(CODE)

 I 'VALID W !,CODE," is not a valid code, try again." G GCODE

 S CODESYS=$$GETCSYS^PXRMLEX(CODE)

 ;DBIA #5679

 S CODESYSP=$P($$CSYS^LEXU(CODESYS),U,4)

 W !,"Searching for ",CODESYSP," code ",CODE

 D CSEARCH(CODESYS,CODE,.NFOUND,.TAXLIST)

 I NFOUND=0 W !,CODE," is not used in any taxonomies." G GCODE

 W !,CODESYSP," ",CODE," is used in the following taxonomies:"

 S TAX=""

 F  S TAX=$O(TAXLIST(TAX)) Q:TAX=""  W !," ",TAX

 G GCODE

 Q

 ; 

PXRMTXCS  ; SLC/PKR - Taxonomy code search routines. ;07/24/2013

 +1       ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404

 +2       ;

 +3       ;=====================================================

CSEARCH(CODESYS,CODE,NFOUND,TAXLIST) ; Search all taxonomies to see if they

 +1       ;contain CODE.

 +2        NEW IEN,NAME

 +3        KILL TAXLIST

 +4        SET NFOUND=0

           SET NAME=""

 +5        FOR 

               SET NAME=$ORDER(^PXD(811.2,"B",NAME))

               IF NAME=""

                   QUIT 

               Begin DoDot:1

 +6                SET IEN=$ORDER(^PXD(811.2,"B",NAME,""))

 +7                IF $DATA(^PXD(811.2,IEN,20,"AE",CODESYS,CODE))

                       SET NFOUND=NFOUND+1

                       SET TAXLIST(NAME)=""

               End DoDot:1

 +8        QUIT 

 +9       ;

 +10      ;=====================================================

SEARCH    ; Let the user input a code then search all taxonomies to determine

 +1       ;which ones include that code.

 +2        NEW CODE,CODESYS,CODESYSL,CODESYSP,DATA,DIR,DIRUT,DTOUT,DUOUT,NFOUND

 +3        NEW TAX,TAXLIST,RESULT,VALID,Y

 +4        DO CODESYSL^PXRMLEX(.CODESYSL)

 +5        SET DIR(0)="FAOU"

 +6        SET DIR("A")="Input a code to search for: "

GCODE      WRITE !

 +1        DO ^DIR

 +2        IF $DATA(DIRUT)

               QUIT 

 +3        SET CODE=Y

 +4       ;See if this is a valid code.

 +5        SET VALID=$$VCODE^PXRMLEX(CODE)

 +6        IF 'VALID

               WRITE !,CODE," is not a valid code, try again."

               GOTO GCODE

 +7        SET CODESYS=$$GETCSYS^PXRMLEX(CODE)

 +8       ;DBIA #5679

 +9        SET CODESYSP=$PIECE($$CSYS^LEXU(CODESYS),U,4)

 +10       WRITE !,"Searching for ",CODESYSP," code ",CODE

 +11       DO CSEARCH(CODESYS,CODE,.NFOUND,.TAXLIST)

 +12       IF NFOUND=0

               WRITE !,CODE," is not used in any taxonomies."

               GOTO GCODE

 +13       WRITE !,CODESYSP," ",CODE," is used in the following taxonomies:"

 +14       SET TAX=""

 +15       FOR 

               SET TAX=$ORDER(TAXLIST(TAX))

               IF TAX=""

                   QUIT 

               WRITE !," ",TAX

 +16       GOTO GCODE

 +17       QUIT 

 +18      ;