- 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 Feb 18, 2025@23:15:45 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 ;