Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMTAXL

PXRMTAXL.m

Go to the documentation of this file. 
  1. PXRMTAXL ;SLC/PKR - List Manager routines for Taxonomies. ;15-Apr-2015 04:49;du
  1.  ;;2.0;CLINICAL REMINDERS;**26,1005**;Feb 04, 2005;Build 23
  1.  ;
  1.  ;=========================================
  1. ADD ;Add a new entry.
  1.  D CLEAR^VALM1
  1.  N DA,DIC,DLAYGO,DTOUT,DUOUT,NEW,Y
  1.  S DIC="^PXD(811.2,"
  1.  S DIC(0)="AEKLQ"
  1.  S DIC("A")="Enter a new Taxonomy Name: "
  1.  S DLAYGO=811.2
  1.  D ^DIC
  1.  I ($D(DTOUT))!($D(DUOUT))!(Y=-1) S VALMBCK="R" Q
  1.  S NEW=$P(Y,U,3)
  1.  I 'NEW D EN^DDIOL("That entry already exists, use EDIT instead.") H 2
  1.  I NEW D
  1.  . S DA=$P(Y,U,1)
  1.  . D SMANEDIT^PXRMTXSM(DA,1,"PXRM TAXONOMY EDIT")
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. BLDLIST(NODE) ;Build of list of Taxomomy file entries.
  1.  N IEN,DESC,FMTSTR,IND,NAME,NL,NUM,OUTPUT,START
  1.  K ^TMP(NODE,$J)
  1.  ;Build the list in alphabetical order.
  1.  S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL")
  1.  S (NUM,VALMCNT)=0
  1.  S NAME=""
  1.  F  S NAME=$O(^PXD(811.2,"B",NAME)) Q:NAME=""  D
  1.  . S IEN=$O(^PXD(811.2,"B",NAME,""))
  1.  . S NUM=NUM+1
  1.  . S ^TMP(NODE,$J,"SEL",NUM)=IEN
  1.  . S ^TMP(NODE,$J,"IEN",IEN)=NUM
  1.  . S DESC=$G(^PXD(811.2,IEN,1,1,0))
  1.  . I $L(DESC)>40 S DESC=$E(DESC,1,37)_"..."
  1.  . D FORMAT(NUM,NAME,DESC,FMTSTR,.NL,.OUTPUT)
  1.  . S START=VALMCNT+1
  1.  . F IND=1:1:NL D
  1.  .. S VALMCNT=VALMCNT+1,^TMP(NODE,$J,VALMCNT,0)=OUTPUT(IND)
  1.  .. S ^TMP(NODE,$J,"IDX",VALMCNT,NUM)=""
  1.  . S ^TMP(NODE,$J,"LINES",NUM)=START_U_VALMCNT
  1.  S ^TMP(NODE,$J,"VALMCNT")=VALMCNT
  1.  S ^TMP(NODE,$J,"NTAX")=NUM
  1.  Q
  1.  ;
  1.  ;=========================================
  1. CLOG(IEN) ;Display the edit history.
  1.  D LMCLBROW^PXRMSINQ(811.2,"110*",IEN)
  1.  Q
  1.  ;
  1.  ;=========================================
  1. CLOGS ;Display Change Log for a selected entry.
  1.  N IEN
  1.  ;Get the entry
  1.  S IEN=+$$GETSEL("Display the change log for which taxonomy?")
  1.  I IEN=0 S VALMBCK="R" Q
  1.  D CLOG(IEN)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. CODESRCH ;Let the user input a code and then search for all taxonomies
  1.  ;that include that code.
  1.  D FULL^VALM1
  1.  W @IOF
  1.  D SEARCH^PXRMTXCS
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. COPY(IEN) ;Copy a selected entry to a new name.
  1.  D FULL^VALM1
  1.  D COPY^PXRMCPLS(811.2,IEN)
  1.  D BLDLIST^PXRMTAXL("PXRMTAXL")
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. COPYS ;Copy a selected entry.
  1.  N IEN
  1.  ;Get the entry
  1.  S IEN=+$$GETSEL("Select taxonomy to copy")
  1.  I IEN=0 S VALMBCK="R" Q
  1.  D COPY(IEN)
  1.  Q
  1.  ;
  1.  ;=========================================
  1. EDITS ;Edit a selected entry.
  1.  N CLASS,IEN
  1.  ;Get the entry
  1.  S IEN=+$$GETSEL("Select the taxonomy to edit")
  1.  I IEN=0 S VALMBCK="R" Q
  1.  D SMANEDIT^PXRMTXSM(IEN,0,"PXRM TAXONOMY EDIT")
  1.  Q
  1.  ;
  1.  ;=========================================
  1. ENTRY ;Entry code
  1.  D INITMPG^PXRMTAXL
  1.  D BLDLIST^PXRMTAXL("PXRMTAXL")
  1.  D XQORM
  1.  Q
  1.  ;
  1.  ;=========================================
  1. EXIT ;Exit code
  1.  D INITMPG^PXRMTAXL
  1.  D CLEAN^VALM10
  1.  D FULL^VALM1
  1.  S VALMBCK="Q"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. FORMAT(NUMBER,NAME,DESC,FMTSTR,NL,OUTPUT) ;Format  entry number, name,
  1.  ;and first line of description for LM display.
  1.  N TEMP
  1.  S TEMP=NUMBER_U_NAME_U_DESC
  1.  D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
  1.  Q
  1.  ;
  1.  ;=========================================
  1. GETSEL(TEXT) ;Get a single selection
  1.  N DIR,NTAX,X,Y
  1.  S NTAX=+$G(^TMP("PXRMTAXL",$J,"NTAX"))
  1.  I NTAX=0 Q 0
  1.  S DIR(0)="N^1:"_NTAX
  1.  S DIR("A")=TEXT
  1.  D ^DIR
  1.  Q +$G(^TMP("PXRMTAXL",$J,"SEL",+Y))
  1.  ;
  1.  ;=========================================
  1. HELP ;Display help.
  1.  N DDS,DIR0,DONE,IND,TEXT
  1.  ;DBIA #5746 covers kill and set of DDS. DDS needs to be set or the
  1.  ;Browser will kill some ScreenMan variables.
  1.  S DDS=1,DONE=0
  1.  F IND=1:1 Q:DONE  D
  1.  . S TEXT(IND)=$P($T(HTEXT+IND),";",3,99)
  1.  . I TEXT(IND)="**End Text**" K TEXT(IND) S DONE=1 Q
  1.  ;IHS/MSC/MGH Newed variables
  1.  N IOSTBM,IORI
  1.  D BROWSE^DDBR("TEXT","NR","Taxonomy Management Help")
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. HDR ; Header code
  1.  S VALMHDR(1)="Taxonomy File Entries."
  1.  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. HTEXT ;Taxonomy mangement help text.
  1.  ;;Select one of the following actions:
  1.  ;; ADD  - add a new taxonomy.
  1.  ;; EDIT - edit a taxonomy.
  1.  ;; COPY - copy an existing taxonomy to a new taxonomy.
  1.  ;; INQ  - taxonomy inquiry.
  1.  ;; EH   - taxonomy edit history.
  1.  ;; CS   - code search. Input a code and search for all taxonomies that include
  1.  ;;        the code.
  1.  ;; IMP  - import codes from another taxonomy or a CSV file. Each line of the CSV
  1.  ;;        file should have the format:
  1.  ;;        term/code,coding system,code 1,code 2,...code n
  1.  ;;
  1.  ;;You can select the action first and then the entry or choose the entry and then
  1.  ;;the action.
  1.  ;;
  1.  ;;OLDINQ displays an old taxonomy inquiry and is provided as an aid in
  1.  ;;transitioning to the new structure. It is only available after selecting a
  1.  ;;taxonomy. It will be removed once the transition has been fully implemented.
  1.  ;;**End Text**
  1.  Q
  1.  ;
  1.  ;=========================================
  1. IMPS ;Import codes into a selected entry.
  1.  N IEN
  1.  ;Get the entry
  1.  S IEN=+$$GETSEL("Select the taxonomy to import into")
  1.  I IEN=0 S VALMBCK="R" Q
  1.  D IMP^PXRMTXIM(IEN)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. INITMPG ;Initialize all the ^TMP globals.
  1.  K ^TMP("PXRMTAXL",$J)
  1.  Q
  1.  ;
  1.  ;=========================================
  1. INQ(IEN) ;Taxonomy inquiry.
  1.  D BTAXINQ^PXRMTXIN(IEN)
  1.  Q
  1.  ;
  1.  ;=========================================
  1. INQS ;Display inquiry for selected entries.
  1.  N IEN
  1.  ;Get the entry
  1.  S IEN=+$$GETSEL("Display inquiry for which taxonomy?")
  1.  I IEN=0 S VALMBCK="R" Q
  1.  D INQ(IEN)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. OLDINQS ;Old Taxonomy inquiry.
  1.  N IEN
  1.  ;Get the entry
  1.  S IEN=+$$GETSEL("Display old inquiry for which taxonomy?")
  1.  I IEN=0 S VALMBCK="R" Q
  1.  D FULL^VALM1
  1.  D OLDINQ^PXRMTXIN(IEN)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;=========================================
  1. PEXIT ; Protocol exit code
  1.  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  1.  ;Reset after page up/down etc
  1.  D XQORM
  1.  Q
  1.  ;
  1.  ;=========================================
  1. START ;Main entry point for PXRM Taxonomy Management
  1.  N VALMBCK,VALMSG,X
  1.  S X="IORESET"
  1.  D ENDR^%ZISS
  1.  D EN^VALM("PXRM TAXONOMY MANAGEMENT")
  1.  W IORESET
  1.  D KILL^%ZISS
  1.  Q
  1.  ;
  1.  ;=========================================
  1. XQORM ;Set range for selection.
  1.  N NTAX
  1.  S NTAX=^TMP("PXRMTAXL",$J,"NTAX")
  1.  S XQORM("#")=$O(^ORD(101,"B","PXRM TAXONOMY SELECT ENTRY",0))_U_"1:"_NTAX
  1.  S XQORM("A")="Select Action: "
  1.  Q
  1.  ;
  1.  ;=========================================
  1. XSEL ;Entry action for protocol PXRM TAXONOMY SELECT ENTRY.
  1.  N CLASS,EDITOK,IEN,SEL
  1.  S SEL=$P(XQORNOD(0),"=",2)
  1.  ;Remove trailing ,
  1.  I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
  1.  ;Invalid selection
  1.  I SEL["," D  Q
  1.  . W !,"Only one item number allowed." H 2
  1.  . S VALMBCK="R"
  1.  I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D  Q
  1.  . W !,SEL_" is not a valid item number." H 2
  1.  . S VALMBCK="R"
  1.  ;
  1.  ;Get the IEN.
  1.  S IEN=^TMP("PXRMTAXL",$J,"SEL",SEL)
  1.  S CLASS=$P(^PXD(811.2,IEN,100),U,1)
  1.  ;
  1.  ;Full screen mode
  1.  D FULL^VALM1
  1.  ;
  1.  ;Action list.
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
  1.  S DIR(0)="SBM"_U
  1.  S EDITOK=$S(CLASS'="N":1,1:($G(PXRMINST)=1)&($G(DUZ(0))="@"))
  1.  I EDITOK S DIR(0)=DIR(0)_"EDIT:Edit;"
  1.  S DIR(0)=DIR(0)_"COPY:Copy;"
  1.  S DIR(0)=DIR(0)_"INQ:Inquire;"
  1.  S DIR(0)=DIR(0)_"CL:Change Log;"
  1.  S DIR("A")="Select Action: "
  1.  S DIR("B")=$S(CLASS="N":"INQ",1:"EDIT")
  1.  S DIR("?")="Select from the actions displayed."
  1.  D ^DIR
  1.  I $D(DIROUT)!$D(DIRUT) S VALMBCK="R" Q
  1.  I $D(DTOUT)!$D(DUOUT) S VALMBCK="R" Q
  1.  S OPTION=Y
  1.  D CLEAR^VALM1
  1.  ;
  1.  I OPTION="COPY" D COPY^PXRMTAXL(IEN)
  1.  I OPTION="EDIT" D SMANEDIT^PXRMTXSM(IEN,0,"PXRM TAXONOMY EDIT")
  1.  I OPTION="INQ" D INQ^PXRMTAXL(IEN)
  1.  I OPTION="CL" D CLOG^PXRMTAXL(IEN)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;