PXRMTAXS.m

PXRMTAXS ; SLC/PKR - Taxonomy search routines. ;12/14/2009

 ;;2.0;CLINICAL REMINDERS;**4,17**;Feb 04, 2005;Build 102

 ;

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

CSEARCH(FILENUM,CODE,CODEIEN,CODETYPE,NFOUND,TAXLIST) ; Search

 ;all taxonomies to see if they contain CODE.

 N PTR,TAX,TAXIEN

 S PTR=$S(FILENUM=80:"ICD9P",FILENUM=80.1:"ICD0P",FILENUM=81:"ICPTP",1:"")

 I PTR="" Q

 K TAXLIST

 S NFOUND=0,TAX=""

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

 . S TAXIEN=$O(^PXD(811.2,"B",TAX,""))

 .;Make sure the expansion exists.

 . I '$D(^PXD(811.3,TAXIEN)) D EXPAND^PXRMBXTL(TAXIEN,"")

 . I $D(^PXD(811.3,TAXIEN,FILENUM,PTR,CODEIEN)) S NFOUND=NFOUND+1,TAXLIST(TAX)=""

 Q

 ;

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

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

 ;if it is being used.

 N CODE,CODEIEN,CODETYPE,DIR,DIRUT,DTOUT,DUOUT,NFOUND

 N TAX,TAXLIST,RETVAL,VALID,Y

 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=0

 S RETVAL=$$CODE^PXRMVAL(CODE,80)

 I $P(RETVAL,U,1)=1 S VALID=80

 I VALID=0 D

 . S RETVAL=$$CODE^PXRMVAL(CODE,80.1)

 . I $P(RETVAL,U,1)=1 S VALID=80.1

 I VALID=0 D

 . S RETVAL=$$CODE^PXRMVAL(CODE,81)

 . I $P(RETVAL,U,1)=1 S VALID=81

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

 S CODETYPE=$P(RETVAL,U,7)

 S CODEIEN=$P(RETVAL,U,8)

 D CSEARCH(VALID,CODE,CODEIEN,CODETYPE,.NFOUND,.TAXLIST)

 I NFOUND=0 W !,CODE," is not used in any taxonmies." Q

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

 S TAX=""

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

 G GCODE

 Q

 ; 

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

SETVAR(TAXARR,ENS,INS,NICD0,NICD9,NCPT,NRCPT,PLS,RAS) ;

 N ALL,TEMP

 ;Initialize the taxonomy search variables.

 S TEMP=$G(TAXARR(0))

 S NICD0=+$P(TEMP,U,3)

 S NICD9=+$P(TEMP,U,5)

 S NCPT=+$P(TEMP,U,7)

 S NRCPT=+$P(TEMP,U,9)

 ;Setup the Patient Data Source control variables.

 S TEMP=$P(TAXARR(811.2,0),U,4)

 ;The default is to search all locations.

 S ALL=$S(TEMP="":1,TEMP="ALL":1,1:0)

 I ALL S (ENS,INS,PLS,RAS)=1 Q

 S ENS=$S(TEMP["EN":1,1:0)

 S INS=$S(TEMP["IN":1,1:0)

 S PLS=$S(TEMP["PL":1,1:0)

 S RAS=$S(TEMP["RA":1,1:0)

 Q

 ;

PXRMTAXS  ; SLC/PKR - Taxonomy search routines. ;12/14/2009

 +1       ;;2.0;CLINICAL REMINDERS;**4,17**;Feb 04, 2005;Build 102

 +2       ;

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

CSEARCH(FILENUM,CODE,CODEIEN,CODETYPE,NFOUND,TAXLIST) ; Search

 +1       ;all taxonomies to see if they contain CODE.

 +2        NEW PTR,TAX,TAXIEN

 +3        SET PTR=$SELECT(FILENUM=80:"ICD9P",FILENUM=80.1:"ICD0P",FILENUM=81:"ICPTP",1:"")

 +4        IF PTR=""

               QUIT 

 +5        KILL TAXLIST

 +6        SET NFOUND=0

           SET TAX=""

 +7        FOR 

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

               IF TAX=""

                   QUIT 

               Begin DoDot:1

 +8                SET TAXIEN=$ORDER(^PXD(811.2,"B",TAX,""))

 +9       ;Make sure the expansion exists.

 +10               IF '$DATA(^PXD(811.3,TAXIEN))

                       DO EXPAND^PXRMBXTL(TAXIEN,"")

 +11               IF $DATA(^PXD(811.3,TAXIEN,FILENUM,PTR,CODEIEN))

                       SET NFOUND=NFOUND+1

                       SET TAXLIST(TAX)=""

               End DoDot:1

 +12       QUIT 

 +13      ;

 +14      ;=====================================================

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

 +1       ;if it is being used.

 +2        NEW CODE,CODEIEN,CODETYPE,DIR,DIRUT,DTOUT,DUOUT,NFOUND

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

 +4        SET DIR(0)="FAOU"

 +5        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=0

 +6        SET RETVAL=$$CODE^PXRMVAL(CODE,80)

 +7        IF $PIECE(RETVAL,U,1)=1

               SET VALID=80

 +8        IF VALID=0

               Begin DoDot:1

 +9                SET RETVAL=$$CODE^PXRMVAL(CODE,80.1)

 +10               IF $PIECE(RETVAL,U,1)=1

                       SET VALID=80.1

               End DoDot:1

 +11       IF VALID=0

               Begin DoDot:1

 +12               SET RETVAL=$$CODE^PXRMVAL(CODE,81)

 +13               IF $PIECE(RETVAL,U,1)=1

                       SET VALID=81

               End DoDot:1

 +14       IF VALID=0

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

               GOTO GCODE

 +15       SET CODETYPE=$PIECE(RETVAL,U,7)

 +16       SET CODEIEN=$PIECE(RETVAL,U,8)

 +17       DO CSEARCH(VALID,CODE,CODEIEN,CODETYPE,.NFOUND,.TAXLIST)

 +18       IF NFOUND=0

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

               QUIT 

 +19       WRITE !,CODETYPE," ",CODE," is used in the following taxonomies:"

 +20       SET TAX=""

 +21       FOR 

               SET TAX=$ORDER(TAXLIST(TAX))

               IF TAX=""

                   QUIT 

               WRITE !," ",TAX

 +22       GOTO GCODE

 +23       QUIT 

 +24      ; 

 +25      ;=====================================================

SETVAR(TAXARR,ENS,INS,NICD0,NICD9,NCPT,NRCPT,PLS,RAS) ;

 +1        NEW ALL,TEMP

 +2       ;Initialize the taxonomy search variables.

 +3        SET TEMP=$GET(TAXARR(0))

 +4        SET NICD0=+$PIECE(TEMP,U,3)

 +5        SET NICD9=+$PIECE(TEMP,U,5)

 +6        SET NCPT=+$PIECE(TEMP,U,7)

 +7        SET NRCPT=+$PIECE(TEMP,U,9)

 +8       ;Setup the Patient Data Source control variables.

 +9        SET TEMP=$PIECE(TAXARR(811.2,0),U,4)

 +10      ;The default is to search all locations.

 +11       SET ALL=$SELECT(TEMP="":1,TEMP="ALL":1,1:0)

 +12       IF ALL

               SET (ENS,INS,PLS,RAS)=1

               QUIT 

 +13       SET ENS=$SELECT(TEMP["EN":1,1:0)

 +14       SET INS=$SELECT(TEMP["IN":1,1:0)

 +15       SET PLS=$SELECT(TEMP["PL":1,1:0)

 +16       SET RAS=$SELECT(TEMP["RA":1,1:0)

 +17       QUIT 

 +18      ;