PXRMTAXL ;SLC/PKR - List Manager routines for Taxonomies. ;08/11/2016
;;2.0;CLINICAL REMINDERS;**26,47**;Feb 04, 2005;Build 291
;
;=========================================
ADD ;Add a new entry.
D CLEAR^VALM1
N DA,DIC,DLAYGO,DTOUT,DUOUT,NEW,Y
S DIC="^PXD(811.2,"
S DIC(0)="AEKLQ"
S DIC("A")="Enter a new Taxonomy Name: "
S DLAYGO=811.2
D ^DIC
I ($D(DTOUT))!($D(DUOUT))!(Y=-1) S VALMBCK="R" Q
S NEW=$P(Y,U,3)
I 'NEW D EN^DDIOL("That entry already exists, use EDIT instead.") H 2
I NEW D
. S DA=$P(Y,U,1)
. D SMANEDIT^PXRMTXSM(DA,1,"PXRM TAXONOMY EDIT")
S VALMBCK="R"
Q
;
;=========================================
BLDLIST(NODE) ;Build of list of Taxomomy file entries.
N IEN,DESC,FMTSTR,IND,NAME,NL,NUM,OUTPUT,START
K ^TMP(NODE,$J)
;Build the list in alphabetical order.
S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL")
S (NUM,VALMCNT)=0
S NAME=""
F S NAME=$O(^PXD(811.2,"B",NAME)) Q:NAME="" D
. S IEN=$O(^PXD(811.2,"B",NAME,""))
. S NUM=NUM+1
. S ^TMP(NODE,$J,"SEL",NUM)=IEN
. S ^TMP(NODE,$J,"IEN",IEN)=NUM
. S DESC=$G(^PXD(811.2,IEN,1,1,0))
. I $L(DESC)>40 S DESC=$E(DESC,1,37)_"..."
. D FORMAT(NUM,NAME,DESC,FMTSTR,.NL,.OUTPUT)
. S START=VALMCNT+1
. F IND=1:1:NL D
.. S VALMCNT=VALMCNT+1,^TMP(NODE,$J,VALMCNT,0)=OUTPUT(IND)
.. S ^TMP(NODE,$J,"IDX",VALMCNT,NUM)=""
. S ^TMP(NODE,$J,"LINES",NUM)=START_U_VALMCNT
S ^TMP(NODE,$J,"VALMCNT")=VALMCNT
S ^TMP(NODE,$J,"NTAX")=NUM
Q
;
;=========================================
CLOG(IEN) ;Display the edit change log.
D LMCLBROW^PXRMSINQ(811.2,"110*",IEN)
Q
;
;=========================================
CLOGS ;Display Change Log for a selected entry.
N IEN
;Get the entry
S IEN=+$$GETSEL("Display the change log for which taxonomy?")
I IEN=0 S VALMBCK="R" Q
D CLOG(IEN)
S VALMBCK="R"
Q
;
;=========================================
CODESRCH ;Let the user input a code and then search for all taxonomies
;that include that code.
D FULL^VALM1
W @IOF
D SEARCH^PXRMTXCS
S VALMBCK="R"
Q
;
;=========================================
COPY(IEN) ;Copy a selected entry to a new name.
D FULL^VALM1
D COPY^PXRMCPLS(811.2,IEN)
D BLDLIST^PXRMTAXL("PXRMTAXL")
S VALMBCK="R"
Q
;
;=========================================
COPYS ;Copy a selected entry.
N IEN
;Get the entry
S IEN=+$$GETSEL("Select taxonomy to copy")
I IEN=0 S VALMBCK="R" Q
D COPY(IEN)
Q
;
;=========================================
EDITS ;Edit a selected entry.
N IEN
;Get the entry
S IEN=+$$GETSEL("Select the taxonomy to edit")
I IEN=0 S VALMBCK="R" Q
D SMANEDIT^PXRMTXSM(IEN,0,"PXRM TAXONOMY EDIT")
Q
;
;=========================================
ENTRY ;Entry code
D INITMPG^PXRMTAXL
D BLDLIST^PXRMTAXL("PXRMTAXL")
D XQORM^PXRMTAXL
Q
;
;=========================================
EXIT ;Exit code
D INITMPG^PXRMTAXL
D CLEAN^VALM10
D FULL^VALM1
S VALMBCK="Q"
Q
;
;=========================================
FORMAT(NUMBER,NAME,DESC,FMTSTR,NL,OUTPUT) ;Format entry number, name,
;and first line of description for LM display.
N TEMP
S TEMP=NUMBER_U_NAME_U_DESC
D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
Q
;
;=========================================
GETSEL(TEXT) ;Get a single selection
N DIR,NTAX,X,Y
S NTAX=+$G(^TMP("PXRMTAXL",$J,"NTAX"))
I NTAX=0 Q 0
S DIR(0)="N^1:"_NTAX
S DIR("A")=TEXT
D ^DIR
Q +$G(^TMP("PXRMTAXL",$J,"SEL",+Y))
;
;=========================================
HELP ;Display help.
N DDS,DIR0,DONE,IND,TEXT
;DBIA #5746 covers kill and set of DDS. DDS needs to be set or the
;Browser will kill some ScreenMan variables.
S DDS=1,DONE=0
F IND=1:1 Q:DONE D
. S TEXT(IND)=$P($T(HTEXT+IND),";",3,99)
. I TEXT(IND)="**End Text**" K TEXT(IND) S DONE=1 Q
D BROWSE^DDBR("TEXT","NR","Taxonomy Management Help")
S VALMBCK="R"
Q
;
;=========================================
HDR ; Header code
S VALMHDR(1)="Taxonomy File Entries."
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
;=========================================
HTEXT ;Taxonomy mangement help text.
;;Select one of the following actions:
;; ADD - add a new taxonomy.
;; EDIT - edit a taxonomy.
;; UIDE - edit the UID status of the selected codes in a taxonomy.
;; COPY - copy an existing taxonomy to a new taxonomy.
;; INQ - taxonomy inquiry.
;; CL - taxonomy change log.
;; CS - code search. Input a code and search for all taxonomies that include
;; the code.
;; IMP - import codes from another taxonomy or a CSV file. Each line of the CSV
;; file should have the format:
;; term/code,coding system,code 1,code 2,...code n
;; VSC - For taxonomies that were generated from a value set, compare the codes
;; in the taxonomy with the codes in the most recent version of the value
;; set.
;;
;;You can select the action first and then the entry or choose the entry and then
;;the action.
;;
;;**End Text**
Q
;
;=========================================
IMPS ;Import codes into a selected entry.
N IEN
;Get the entry
S IEN=+$$GETSEL("Select the taxonomy to import into")
I IEN=0 S VALMBCK="R" Q
D IMP^PXRMTXIM(IEN)
S VALMBCK="R"
Q
;
;=========================================
INITMPG ;Initialize all the ^TMP globals.
K ^TMP("PXRMTAXL",$J)
Q
;
;=========================================
INQ(IEN) ;Taxonomy inquiry.
D BTAXINQ^PXRMTXIN(IEN)
Q
;
;=========================================
INQS ;Display inquiry for selected entries.
N IEN
;Get the entry
S IEN=+$$GETSEL("Display inquiry for which taxonomy?")
I IEN=0 S VALMBCK="R" Q
D INQ(IEN)
S VALMBCK="R"
Q
;
;=========================================
PEXIT ; Protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
;Reset after page up/down etc
D XQORM^PXRMTAXL
Q
;
;=========================================
START ;Main entry point for PXRM Taxonomy Management
N VALMBCK,VALMSG,X
S X="IORESET"
D ENDR^%ZISS
D EN^VALM("PXRM TAXONOMY MANAGEMENT")
W IORESET
D KILL^%ZISS
Q
;
;=========================================
UIDE(TAXIEN) ;Edit UID for a selected taxonomy.
K ^TMP("PXRMTAX",$J)
S ^TMP("PXRMTAX",$J,"TAXIEN")=TAXIEN
D EN^VALM("PXRM TAXONOMY UID EDIT")
K ^TMP("PXRMTAX",$J)
S VALMBCK="R"
Q
;
;=========================================
UIDES ;Edit UID for a selected taxonomy.
N IEN
;Get the entry
S IEN=+$$GETSEL("Select the taxonomy for UID edit")
I IEN=0 S VALMBCK="R" Q
D UIDE^PXRMTAXL(IEN)
Q
;
;=========================================
VSCMP(TAXIEN,VSOID) ;For taxonomies generated from a value compare the codes
;in the taxonomy with those in the value set.
N NL,OUTPUT
S NL=0
I VSOID'="" D CMPTXVS^PXRMVSTX(IEN,VSOID,.NL,.OUTPUT)
I VSOID="" S NL=NL+1,OUTPUT(NL)="This taxonomy was not generated from a value set."
D BROWSE^DDBR("OUTPUT","NR","Taxonomy Value Set Code Comparison")
Q
;
;=========================================
VSCMPS ;Value set comparison.
N DIR,IEN,VSOID,X,Y
S DIR(0)="SAB"_U_"A:All;O:One"
S DIR("A")="Compare one taxonomy or all? "
S DIR("B")="O"
D ^DIR
I Y="A" D CMPALL^PXRMVSTX("B")
I Y="O" D
.;Get the single entry
. S IEN=+$$GETSEL("Value sets comparison for which taxonomy?")
. I IEN=0 S VALMBCK="R" Q
. S VSOID=$P($G(^PXD(811.2,IEN,40)),U,1)
. D VSCMP(IEN,VSOID)
S VALMBCK="R"
Q
;
;=========================================
XQORM ;Set range for selection.
N NTAX
S NTAX=^TMP("PXRMTAXL",$J,"NTAX")
S XQORM("#")=$O(^ORD(101,"B","PXRM TAXONOMY SELECT ENTRY",0))_U_"1:"_NTAX
S XQORM("A")="Select Action: "
Q
;
;=========================================
XSEL ;Entry action for protocol PXRM TAXONOMY SELECT ENTRY.
N CLASS,EDITOK,IEN,SEL,VSOID
S SEL=$P(XQORNOD(0),"=",2)
;Remove trailing ,
I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
;Invalid selection
I SEL["," D Q
. W !,"Only one item number allowed." H 2
. S VALMBCK="R"
I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
. W !,SEL_" is not a valid item number." H 2
. S VALMBCK="R"
;
;Get the IEN.
S IEN=^TMP("PXRMTAXL",$J,"SEL",SEL)
S CLASS=$P(^PXD(811.2,IEN,100),U,1)
;
;Full screen mode
D FULL^VALM1
;
;Action list.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
S DIR(0)="SBM"_U
S EDITOK=$S(CLASS'="N":1,1:($G(PXRMINST)=1)&($G(DUZ(0))="@"))
I EDITOK S DIR(0)=DIR(0)_"EDIT:Edit;"
S DIR(0)=DIR(0)_"COPY:Copy;"
S DIR(0)=DIR(0)_"UIDE:UID Edit;"
S DIR(0)=DIR(0)_"INQ:Inquire;"
S DIR(0)=DIR(0)_"CL:Change Log;"
S VSOID=$P($G(^PXD(811.2,IEN,40)),U,1)
I VSOID'="" S DIR(0)=DIR(0)_"VSC:Value Set Compare;"
S DIR("A")="Select Action: "
S DIR("B")=$S(CLASS="N":"INQ",1:"EDIT")
S DIR("?")="Select from the actions displayed."
D ^DIR
I $D(DIROUT)!$D(DIRUT) S VALMBCK="R" Q
I $D(DTOUT)!$D(DUOUT) S VALMBCK="R" Q
S OPTION=Y
D CLEAR^VALM1
;
I OPTION="COPY" D COPY^PXRMTAXL(IEN)
I OPTION="EDIT" D SMANEDIT^PXRMTXSM(IEN,0,"PXRM TAXONOMY EDIT")
I OPTION="UIDE" D UIDE^PXRMTAXL(IEN)
I OPTION="INQ" D INQ^PXRMTAXL(IEN)
I OPTION="CL" D CLOG^PXRMTAXL(IEN)
I OPTION="VSC" D VSCMP^PXRMTAXL(IEN,VSOID)
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMTAXL 9291 printed Apr 09, 2024@20:50:18 Page 2
PXRMTAXL ;SLC/PKR - List Manager routines for Taxonomies. ;08/11/2016
+1 ;;2.0;CLINICAL REMINDERS;**26,47**;Feb 04, 2005;Build 291
+2 ;
+3 ;=========================================
ADD ;Add a new entry.
+1 DO CLEAR^VALM1
+2 NEW DA,DIC,DLAYGO,DTOUT,DUOUT,NEW,Y
+3 SET DIC="^PXD(811.2,"
+4 SET DIC(0)="AEKLQ"
+5 SET DIC("A")="Enter a new Taxonomy Name: "
+6 SET DLAYGO=811.2
+7 DO ^DIC
+8 IF ($DATA(DTOUT))!($DATA(DUOUT))!(Y=-1)
SET VALMBCK="R"
QUIT
+9 SET NEW=$PIECE(Y,U,3)
+10 IF 'NEW
DO EN^DDIOL("That entry already exists, use EDIT instead.")
HANG 2
+11 IF NEW
Begin DoDot:1
+12 SET DA=$PIECE(Y,U,1)
+13 DO SMANEDIT^PXRMTXSM(DA,1,"PXRM TAXONOMY EDIT")
End DoDot:1
+14 SET VALMBCK="R"
+15 QUIT
+16 ;
+17 ;=========================================
BLDLIST(NODE) ;Build of list of Taxomomy file entries.
+1 NEW IEN,DESC,FMTSTR,IND,NAME,NL,NUM,OUTPUT,START
+2 KILL ^TMP(NODE,$JOB)
+3 ;Build the list in alphabetical order.
+4 SET FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL")
+5 SET (NUM,VALMCNT)=0
+6 SET NAME=""
+7 FOR
SET NAME=$ORDER(^PXD(811.2,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+8 SET IEN=$ORDER(^PXD(811.2,"B",NAME,""))
+9 SET NUM=NUM+1
+10 SET ^TMP(NODE,$JOB,"SEL",NUM)=IEN
+11 SET ^TMP(NODE,$JOB,"IEN",IEN)=NUM
+12 SET DESC=$GET(^PXD(811.2,IEN,1,1,0))
+13 IF $LENGTH(DESC)>40
SET DESC=$EXTRACT(DESC,1,37)_"..."
+14 DO FORMAT(NUM,NAME,DESC,FMTSTR,.NL,.OUTPUT)
+15 SET START=VALMCNT+1
+16 FOR IND=1:1:NL
Begin DoDot:2
+17 SET VALMCNT=VALMCNT+1
SET ^TMP(NODE,$JOB,VALMCNT,0)=OUTPUT(IND)
+18 SET ^TMP(NODE,$JOB,"IDX",VALMCNT,NUM)=""
End DoDot:2
+19 SET ^TMP(NODE,$JOB,"LINES",NUM)=START_U_VALMCNT
End DoDot:1
+20 SET ^TMP(NODE,$JOB,"VALMCNT")=VALMCNT
+21 SET ^TMP(NODE,$JOB,"NTAX")=NUM
+22 QUIT
+23 ;
+24 ;=========================================
CLOG(IEN) ;Display the edit change log.
+1 DO LMCLBROW^PXRMSINQ(811.2,"110*",IEN)
+2 QUIT
+3 ;
+4 ;=========================================
CLOGS ;Display Change Log for a selected entry.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL("Display the change log for which taxonomy?")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO CLOG(IEN)
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
+9 ;=========================================
CODESRCH ;Let the user input a code and then search for all taxonomies
+1 ;that include that code.
+2 DO FULL^VALM1
+3 WRITE @IOF
+4 DO SEARCH^PXRMTXCS
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;=========================================
COPY(IEN) ;Copy a selected entry to a new name.
+1 DO FULL^VALM1
+2 DO COPY^PXRMCPLS(811.2,IEN)
+3 DO BLDLIST^PXRMTAXL("PXRMTAXL")
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
+7 ;=========================================
COPYS ;Copy a selected entry.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL("Select taxonomy to copy")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO COPY(IEN)
+6 QUIT
+7 ;
+8 ;=========================================
EDITS ;Edit a selected entry.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL("Select the taxonomy to edit")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO SMANEDIT^PXRMTXSM(IEN,0,"PXRM TAXONOMY EDIT")
+6 QUIT
+7 ;
+8 ;=========================================
ENTRY ;Entry code
+1 DO INITMPG^PXRMTAXL
+2 DO BLDLIST^PXRMTAXL("PXRMTAXL")
+3 DO XQORM^PXRMTAXL
+4 QUIT
+5 ;
+6 ;=========================================
EXIT ;Exit code
+1 DO INITMPG^PXRMTAXL
+2 DO CLEAN^VALM10
+3 DO FULL^VALM1
+4 SET VALMBCK="Q"
+5 QUIT
+6 ;
+7 ;=========================================
FORMAT(NUMBER,NAME,DESC,FMTSTR,NL,OUTPUT) ;Format entry number, name,
+1 ;and first line of description for LM display.
+2 NEW TEMP
+3 SET TEMP=NUMBER_U_NAME_U_DESC
+4 DO COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
+5 QUIT
+6 ;
+7 ;=========================================
GETSEL(TEXT) ;Get a single selection
+1 NEW DIR,NTAX,X,Y
+2 SET NTAX=+$GET(^TMP("PXRMTAXL",$JOB,"NTAX"))
+3 IF NTAX=0
QUIT 0
+4 SET DIR(0)="N^1:"_NTAX
+5 SET DIR("A")=TEXT
+6 DO ^DIR
+7 QUIT +$GET(^TMP("PXRMTAXL",$JOB,"SEL",+Y))
+8 ;
+9 ;=========================================
HELP ;Display help.
+1 NEW DDS,DIR0,DONE,IND,TEXT
+2 ;DBIA #5746 covers kill and set of DDS. DDS needs to be set or the
+3 ;Browser will kill some ScreenMan variables.
+4 SET DDS=1
SET DONE=0
+5 FOR IND=1:1
if DONE
QUIT
Begin DoDot:1
+6 SET TEXT(IND)=$PIECE($TEXT(HTEXT+IND),";",3,99)
+7 IF TEXT(IND)="**End Text**"
KILL TEXT(IND)
SET DONE=1
QUIT
End DoDot:1
+8 DO BROWSE^DDBR("TEXT","NR","Taxonomy Management Help")
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
+12 ;=========================================
HDR ; Header code
+1 SET VALMHDR(1)="Taxonomy File Entries."
+2 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+3 QUIT
+4 ;
+5 ;=========================================
HTEXT ;Taxonomy mangement help text.
+1 ;;Select one of the following actions:
+2 ;; ADD - add a new taxonomy.
+3 ;; EDIT - edit a taxonomy.
+4 ;; UIDE - edit the UID status of the selected codes in a taxonomy.
+5 ;; COPY - copy an existing taxonomy to a new taxonomy.
+6 ;; INQ - taxonomy inquiry.
+7 ;; CL - taxonomy change log.
+8 ;; CS - code search. Input a code and search for all taxonomies that include
+9 ;; the code.
+10 ;; IMP - import codes from another taxonomy or a CSV file. Each line of the CSV
+11 ;; file should have the format:
+12 ;; term/code,coding system,code 1,code 2,...code n
+13 ;; VSC - For taxonomies that were generated from a value set, compare the codes
+14 ;; in the taxonomy with the codes in the most recent version of the value
+15 ;; set.
+16 ;;
+17 ;;You can select the action first and then the entry or choose the entry and then
+18 ;;the action.
+19 ;;
+20 ;;**End Text**
+21 QUIT
+22 ;
+23 ;=========================================
IMPS ;Import codes into a selected entry.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL("Select the taxonomy to import into")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO IMP^PXRMTXIM(IEN)
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
+9 ;=========================================
INITMPG ;Initialize all the ^TMP globals.
+1 KILL ^TMP("PXRMTAXL",$JOB)
+2 QUIT
+3 ;
+4 ;=========================================
INQ(IEN) ;Taxonomy inquiry.
+1 DO BTAXINQ^PXRMTXIN(IEN)
+2 QUIT
+3 ;
+4 ;=========================================
INQS ;Display inquiry for selected entries.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL("Display inquiry for which taxonomy?")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO INQ(IEN)
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
+9 ;=========================================
PEXIT ; Protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 ;Reset after page up/down etc
+3 DO XQORM^PXRMTAXL
+4 QUIT
+5 ;
+6 ;=========================================
START ;Main entry point for PXRM Taxonomy Management
+1 NEW VALMBCK,VALMSG,X
+2 SET X="IORESET"
+3 DO ENDR^%ZISS
+4 DO EN^VALM("PXRM TAXONOMY MANAGEMENT")
+5 WRITE IORESET
+6 DO KILL^%ZISS
+7 QUIT
+8 ;
+9 ;=========================================
UIDE(TAXIEN) ;Edit UID for a selected taxonomy.
+1 KILL ^TMP("PXRMTAX",$JOB)
+2 SET ^TMP("PXRMTAX",$JOB,"TAXIEN")=TAXIEN
+3 DO EN^VALM("PXRM TAXONOMY UID EDIT")
+4 KILL ^TMP("PXRMTAX",$JOB)
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;=========================================
UIDES ;Edit UID for a selected taxonomy.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL("Select the taxonomy for UID edit")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO UIDE^PXRMTAXL(IEN)
+6 QUIT
+7 ;
+8 ;=========================================
VSCMP(TAXIEN,VSOID) ;For taxonomies generated from a value compare the codes
+1 ;in the taxonomy with those in the value set.
+2 NEW NL,OUTPUT
+3 SET NL=0
+4 IF VSOID'=""
DO CMPTXVS^PXRMVSTX(IEN,VSOID,.NL,.OUTPUT)
+5 IF VSOID=""
SET NL=NL+1
SET OUTPUT(NL)="This taxonomy was not generated from a value set."
+6 DO BROWSE^DDBR("OUTPUT","NR","Taxonomy Value Set Code Comparison")
+7 QUIT
+8 ;
+9 ;=========================================
VSCMPS ;Value set comparison.
+1 NEW DIR,IEN,VSOID,X,Y
+2 SET DIR(0)="SAB"_U_"A:All;O:One"
+3 SET DIR("A")="Compare one taxonomy or all? "
+4 SET DIR("B")="O"
+5 DO ^DIR
+6 IF Y="A"
DO CMPALL^PXRMVSTX("B")
+7 IF Y="O"
Begin DoDot:1
+8 ;Get the single entry
+9 SET IEN=+$$GETSEL("Value sets comparison for which taxonomy?")
+10 IF IEN=0
SET VALMBCK="R"
QUIT
+11 SET VSOID=$PIECE($GET(^PXD(811.2,IEN,40)),U,1)
+12 DO VSCMP(IEN,VSOID)
End DoDot:1
+13 SET VALMBCK="R"
+14 QUIT
+15 ;
+16 ;=========================================
XQORM ;Set range for selection.
+1 NEW NTAX
+2 SET NTAX=^TMP("PXRMTAXL",$JOB,"NTAX")
+3 SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM TAXONOMY SELECT ENTRY",0))_U_"1:"_NTAX
+4 SET XQORM("A")="Select Action: "
+5 QUIT
+6 ;
+7 ;=========================================
XSEL ;Entry action for protocol PXRM TAXONOMY SELECT ENTRY.
+1 NEW CLASS,EDITOK,IEN,SEL,VSOID
+2 SET SEL=$PIECE(XQORNOD(0),"=",2)
+3 ;Remove trailing ,
+4 IF $EXTRACT(SEL,$LENGTH(SEL))=","
SET SEL=$EXTRACT(SEL,1,$LENGTH(SEL)-1)
+5 ;Invalid selection
+6 IF SEL[","
Begin DoDot:1
+7 WRITE !,"Only one item number allowed."
HANG 2
+8 SET VALMBCK="R"
End DoDot:1
QUIT
+9 IF ('SEL)!(SEL>VALMCNT)!('$DATA(@VALMAR@("SEL",SEL)))
Begin DoDot:1
+10 WRITE !,SEL_" is not a valid item number."
HANG 2
+11 SET VALMBCK="R"
End DoDot:1
QUIT
+12 ;
+13 ;Get the IEN.
+14 SET IEN=^TMP("PXRMTAXL",$JOB,"SEL",SEL)
+15 SET CLASS=$PIECE(^PXD(811.2,IEN,100),U,1)
+16 ;
+17 ;Full screen mode
+18 DO FULL^VALM1
+19 ;
+20 ;Action list.
+21 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
+22 SET DIR(0)="SBM"_U
+23 SET EDITOK=$SELECT(CLASS'="N":1,1:($GET(PXRMINST)=1)&($GET(DUZ(0))="@"))
+24 IF EDITOK
SET DIR(0)=DIR(0)_"EDIT:Edit;"
+25 SET DIR(0)=DIR(0)_"COPY:Copy;"
+26 SET DIR(0)=DIR(0)_"UIDE:UID Edit;"
+27 SET DIR(0)=DIR(0)_"INQ:Inquire;"
+28 SET DIR(0)=DIR(0)_"CL:Change Log;"
+29 SET VSOID=$PIECE($GET(^PXD(811.2,IEN,40)),U,1)
+30 IF VSOID'=""
SET DIR(0)=DIR(0)_"VSC:Value Set Compare;"
+31 SET DIR("A")="Select Action: "
+32 SET DIR("B")=$SELECT(CLASS="N":"INQ",1:"EDIT")
+33 SET DIR("?")="Select from the actions displayed."
+34 DO ^DIR
+35 IF $DATA(DIROUT)!$DATA(DIRUT)
SET VALMBCK="R"
QUIT
+36 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMBCK="R"
QUIT
+37 SET OPTION=Y
+38 DO CLEAR^VALM1
+39 ;
+40 IF OPTION="COPY"
DO COPY^PXRMTAXL(IEN)
+41 IF OPTION="EDIT"
DO SMANEDIT^PXRMTXSM(IEN,0,"PXRM TAXONOMY EDIT")
+42 IF OPTION="UIDE"
DO UIDE^PXRMTAXL(IEN)
+43 IF OPTION="INQ"
DO INQ^PXRMTAXL(IEN)
+44 IF OPTION="CL"
DO CLOG^PXRMTAXL(IEN)
+45 IF OPTION="VSC"
DO VSCMP^PXRMTAXL(IEN,VSOID)
+46 SET VALMBCK="R"
+47 QUIT
+48 ;
