PXRMTDUP.m

PXRMTDUP ; SLC/PKR - Update Taxonomy Dialog Selectable codes.;04/04/2003

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;

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

BUILD(TIEN) ;Build the list of selectable codes for one taxonomy.

 N DATEBLT,FILE,NODE,PTR,TEMP

 S TEMP=$G(^PXD(811.3,TIEN,0))

 S DATEBLT=$P(TEMP,U,2)

 ;Make sure the expansion exists.

 I DATEBLT="" D EXPAND^PXRMBXTL(TIEN,"")

 ;Copy the expansion into the selectable lists.

 F FILE=80,81 D

 . S NODE=$S(FILE=80:"SDX",FILE=81:"SPR")

 . S PTR=$S(FILE=80:"ICD9P",FILE=81:"ICPTP")

 . K ^PXD(811.2,TIEN,NODE)

 . M ^PXD(811.2,TIEN,NODE)=^PXD(811.3,TIEN,FILE)

 . M ^PXD(811.2,TIEN,NODE,"B")=^PXD(811.3,TIEN,FILE,PTR)

 . K ^PXD(811.2,TIEN,NODE,PTR)

 Q

 ;

PXRMTDUP  ; SLC/PKR - Update Taxonomy Dialog Selectable codes.;04/04/2003

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

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

BUILD(TIEN) ;Build the list of selectable codes for one taxonomy.

 +1        NEW DATEBLT,FILE,NODE,PTR,TEMP

 +2        SET TEMP=$GET(^PXD(811.3,TIEN,0))

 +3        SET DATEBLT=$PIECE(TEMP,U,2)

 +4       ;Make sure the expansion exists.

 +5        IF DATEBLT=""

               DO EXPAND^PXRMBXTL(TIEN,"")

 +6       ;Copy the expansion into the selectable lists.

 +7        FOR FILE=80,81

               Begin DoDot:1

 +8                SET NODE=$SELECT(FILE=80:"SDX",FILE=81:"SPR")

 +9                SET PTR=$SELECT(FILE=80:"ICD9P",FILE=81:"ICPTP")

 +10               KILL ^PXD(811.2,TIEN,NODE)

 +11               MERGE ^PXD(811.2,TIEN,NODE)=^PXD(811.3,TIEN,FILE)

 +12               MERGE ^PXD(811.2,TIEN,NODE,"B")=^PXD(811.3,TIEN,FILE,PTR)

 +13               KILL ^PXD(811.2,TIEN,NODE,PTR)

               End DoDot:1

 +14       QUIT 

 +15      ;