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

PXRMLEXL.m

Go to the documentation of this file.
  1. PXRMLEXL ;SLC/PKR - List Manager routines for Taxonomies and Lexicon. ;08/16/2018
  1. ;;2.0;CLINICAL REMINDERS;**26,47,42**;Feb 04, 2005;Build 245
  1. ;
  1. ;=========================================
  1. ADDSEL(ENUM,UID) ;Add entry ENUM to the selected list and highlight it.
  1. N CODE
  1. S CODE=^TMP("PXRMLEXL",$J,"CODE",ENUM)
  1. S ^TMP("PXRMLEXL",$J,"SELECTED",ENUM)=CODE_U_UID
  1. D HLITE(ENUM,1,UID)
  1. Q
  1. ;
  1. ;=========================================
  1. BLDLIST ;Build the Lexicon list.
  1. N CODE,CODESYS,CODESYSP,DESC,ENUM,FMTSTR,IND,JND
  1. N NCODES,NL,NLINES,NSEL,NUID,NUM,OUTPUT,START,TAXIEN,TERM,TEXT,UID
  1. S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLLL")
  1. ;^TMP("PXRMLEXTC",$J) nodes are set in PXRMTXSM which calls this
  1. ;List Manager selection.
  1. ;Clear the display.
  1. D KILL^VALM10
  1. K ^TMP("PXRMLEXL",$J)
  1. S CODESYS=^TMP("PXRMLEXTC",$J,"CODESYS")
  1. S TAXIEN=^TMP("PXRMLEXTC",$J,"TAX IEN")
  1. S TERM=^TMP("PXRMLEXTC",$J,"LEX TERM")
  1. I '$D(^TMP("PXRMLEXS",$J,TERM,CODESYS)) D
  1. . D LEXLIST(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT)
  1. . M ^TMP("PXRMTEXT",$J,TERM,CODESYS,"TEXT")=TEXT
  1. . S ^TMP("PXRMTEXT",$J,TERM,CODESYS,"NCODES")=NCODES
  1. . S ^TMP("PXRMTEXT",$J,TERM,CODESYS,"NLINES")=NLINES
  1. I $D(^TMP("PXRMTEXT",$J,TERM,CODESYS)) D
  1. . S NCODES=^TMP("PXRMTEXT",$J,TERM,CODESYS,"NCODES")
  1. . S NLINES=^TMP("PXRMTEXT",$J,TERM,CODESYS,"NLINES")
  1. ;Get the coding system Lexicon information for building the display.
  1. ;DBIA #5679
  1. S CODESYSP=$$CSYS^LEXU(CODESYS)
  1. S TEXT=^TMP("PXRMLEXTC",$J,"LEX TERM")
  1. S TEXT=$S(($L(TEXT)'>66):TEXT,1:$E(TEXT,1,63)_"...")
  1. S VALMHDR(1)="Term/Code: "_TEXT
  1. S VALMHDR(2)=NCODES_" "_$P(CODESYSP,U,4)_$S(NCODES=1:" code was found",1:" codes were found")
  1. I NCODES=1,'$$UIDOK S VALMHDR(2)=VALMHDR(2)_", it cannot be used in a dialog."
  1. I NCODES>1,'$$UIDOK S VALMHDR(2)=VALMHDR(2)_", these cannot be used in a dialog."
  1. ;Set these so LM shows Page 1 of 1 when there are no codes.
  1. I NCODES=0 S VALMHDR(2)=VALMHDR(2)_".",^TMP("PXRMLEXL",$J,1,0)="",VALMCNT=1 Q
  1. ;
  1. ;If the display list has been saved restore it, if not build it.
  1. I $D(^TMP("PXRMLEXS",$J,TERM,CODESYS)) D
  1. . M ^TMP("PXRMLEXL",$J)=^TMP("PXRMLEXS",$J,TERM,CODESYS)
  1. . S VALMCNT=^TMP("PXRMLEXS",$J,TERM,CODESYS,"VALMCNT")
  1. I '$D(^TMP("PXRMLEXS",$J,TERM,CODESYS)) D
  1. . S VALMCNT=0
  1. . F IND=1:1:NLINES D
  1. .. S NUM=$P(TEXT(IND),U,1),CODE=$P(TEXT(IND),U,2)
  1. .. I NUM'="",CODE'="" S ENUM=NUM,^TMP("PXRMLEXL",$J,"CODE",NUM)=CODE,START=VALMCNT+1
  1. .. D FORMAT(TEXT(IND),FMTSTR,.NL,.OUTPUT)
  1. .. F JND=1:1:NL D
  1. ... S VALMCNT=VALMCNT+1,^TMP("PXRMLEXL",$J,VALMCNT,0)=OUTPUT(JND)
  1. ... S ^TMP("PXRMLEXL",$J,"IDX",VALMCNT,ENUM)=""
  1. .. S ^TMP("PXRMLEXL",$J,"LINES",ENUM)=START_U_VALMCNT
  1. . S ^TMP("PXRMLEXL",$J,"NCODES")=NCODES
  1. . S ^TMP("PXRMLEXL",$J,"VALMCNT")=VALMCNT
  1. ;If the display list has not been saved, save it.
  1. I '$D(^TMP("PXRMLEXS",$J,TERM,CODESYS)) M ^TMP("PXRMLEXS",$J,TERM,CODESYS)=^TMP("PXRMLEXL",$J)
  1. ;
  1. ;Mark any entries that were previously selected.
  1. S ENUM="",(NSEL,NUID)=0
  1. F S ENUM=$O(^TMP("PXRMLEXL",$J,"CODE",ENUM)) Q:ENUM="" D
  1. . S CODE=^TMP("PXRMLEXL",$J,"CODE",ENUM)
  1. . I CODE'="",$D(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) D Q
  1. .. S NSEL=NSEL+1
  1. .. S UID=+^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
  1. .. I UID S NUID=NUID+1
  1. .. D ADDSEL(ENUM,UID)
  1. I NSEL=1 S VALMHDR(2)=VALMHDR(2)_" "_NSEL_" is selected."
  1. I NSEL>1 S VALMHDR(2)=VALMHDR(2)_" "_NSEL_" are selected."
  1. S PXRMLEXV="ALL"
  1. I $D(PXRMBGS("ALL")) S VALMBG=PXRMBGS("ALL")
  1. Q
  1. ;
  1. ;=========================================
  1. CPLIST(TAXIEN,TERM,CODESYS,NCODES,NLINES,TEXT) ;Build the list for a copy from
  1. ;a range list of codes.
  1. N ACTDT,CODE,DATA,INACTDT,NUM,SDESC,TEMP
  1. S CODE="",(NCODES,NLINES)=0
  1. F S CODE=$O(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q:CODE="" D
  1. . K DATA
  1. .;DBIA #1997, #3991
  1. . I CODESYS="CPC" D PERIOD^ICPTAPIU(CODE,.DATA)
  1. . I CODESYS="CPT" D PERIOD^ICPTAPIU(CODE,.DATA)
  1. . I CODESYS="ICD" D PERIOD^ICDAPIU(CODE,.DATA)
  1. . I CODESYS="ICP" D PERIOD^ICDAPIU(CODE,.DATA)
  1. . I +DATA(0)=-1 Q
  1. . S NCODES=NCODES+1
  1. . S (ACTDT,NUM)=0
  1. . F S ACTDT=$O(DATA(ACTDT)) Q:ACTDT="" D
  1. .. S TEMP=DATA(ACTDT)
  1. .. S NUM=NUM+1
  1. .. S INACTDT=$P(TEMP,U,1)
  1. .. S SDESC=$P(TEMP,U,2)
  1. .. S NLINES=NLINES+1
  1. .. I NUM=1 S TEXT(NLINES)=NCODES_U_CODE_U_ACTDT_U_INACTDT_U_SDESC
  1. .. E S TEXT(NLINES)=U_U_ACTDT_U_INACTDT_U_SDESC
  1. Q
  1. ;
  1. ;=========================================
  1. ENTRY ;Entry code
  1. D INITMPG^PXRMLEXL
  1. D BLDLIST^PXRMLEXL
  1. D XQORM^PXRMLEXL
  1. Q
  1. ;
  1. ;=========================================
  1. EXIT ;Exit code
  1. D INITMPG^PXRMLEXL
  1. D FULL^VALM1
  1. D CLEAN^VALM10
  1. D KILL^VALM10
  1. D CLEAR^VALM1
  1. S VALMBCK="Q"
  1. Q
  1. ;
  1. ;=========================================
  1. EXITS ;Exit and save action.
  1. D SAVE^PXRMLEXL
  1. S VALMBCK="Q"
  1. Q
  1. ;
  1. ;=========================================
  1. FORMAT(TEXT,FMTSTR,NL,OUTPUT) ;Format entry number, code,
  1. ;activation date, inactivation date, short text for LM display.
  1. N ACTDT,INACTDT
  1. S ACTDT=$P(TEXT,U,3),INACTDT=$P(TEXT,U,4)
  1. S ACTDT=$$FMTE^XLFDT(ACTDT,5)
  1. S INACTDT=$$FMTE^XLFDT(INACTDT,5)
  1. S $P(TEXT,U,3)=ACTDT,$P(TEXT,U,4)=INACTDT
  1. D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
  1. Q
  1. ;
  1. ;=========================================
  1. GETLIST(LIST) ;Let the user input a list of items.
  1. N DIR,INUM,ITEM,LEND,LELEM,NCODES,LSTART,X,Y
  1. S NCODES=+$G(^TMP("PXRMLEXL",$J,"NCODES"))
  1. I NCODES=0 Q
  1. I NCODES=1 S LIST(1)="" Q
  1. S DIR(0)="LC^1:"_NCODES
  1. D ^DIR
  1. I $E(Y,1)="^" Q
  1. ;Populate the list.
  1. F INUM=1:1:($L(Y,",")-1) D
  1. . S LELEM=$P(Y,",",INUM)
  1. . I LELEM?1.N S LIST(LELEM)=""
  1. . S LSTART=$P(LELEM,"-",1),LEND=$P(LELEM,"-",2)
  1. . F ITEM=LSTART:1:LEND S LIST(ITEM)=""
  1. Q
  1. ;
  1. ;=========================================
  1. HDR ; Header code
  1. S VALMHDR(1)="Select Lexicon items to include in the taxonomy."
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. Q
  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. D BROWSE^DDBR("TEXT","NR","Lexicon Selection Help")
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. HLITE(ENUM,MODE,UID) ;Highlight/un-highlight an entry. MODE=1 turns on
  1. ;highlighting, MODE=0 turns it off.
  1. N LINE,START,STOP,VCTRL
  1. S VCTRL=$S(MODE=1:IOINHI,1:IOINORM)
  1. S START=$P(^TMP("PXRMLEXL",$J,"LINES",ENUM),U,1)
  1. S STOP=$P(^TMP("PXRMLEXL",$J,"LINES",ENUM),U,2)
  1. F LINE=START:1:STOP D CNTRL^VALM10(LINE,1,80,VCTRL,IOINORM)
  1. ;If the entry is marked Use In Dialog turn on marker.
  1. I MODE=1,UID=1 D FLDCTRL^VALM10(START,"CODE",IORVON,IORVOFF,"")
  1. I MODE=0 D FLDCTRL^VALM10(START,"CODE",IORVOFF,IORVOFF,"")
  1. Q
  1. ;
  1. ;=========================================
  1. HTEXT ;Lexicon selection help text.
  1. ;;Select one of the following actions:
  1. ;;
  1. ;; ADD - adds selected codes to the taxonomy.
  1. ;; RFT - removes selected codes from the taxonomy.
  1. ;; RFD - removes selected codes from being used in a dialog.
  1. ;; UID - adds selected codes to the taxonomy and marks them for use in a dialog.
  1. ;; SAVE - saves all selected codes. Even if codes have been selected, they will
  1. ;; not be stored until they are saved. Finally, a save must be done when
  1. ;; exiting the ScreenMan form or no changes will be saved.
  1. ;; EXIT - saves then exits.
  1. ;;
  1. ;;Some coding systems cannot be used in a dialog; in those cases, the RFD and UID
  1. ;;actions cannot be selected. Actions that cannot be selected have their text
  1. ;;description surrounded by parentheses. For example, when a coding system can be
  1. ;;used in a dialog, the UID action will look like this:
  1. ;; UID Use in dialog
  1. ;;When the coding system cannot be used in a dialog, it will look like this:
  1. ;; UID (Use in dialog)
  1. ;;
  1. ;;You can select the action first and then be prompted for a list of codes or
  1. ;;you can input the list and then select the action. Because of the way List
  1. ;;Manager works, you may be able to select a larger list by selecting the action
  1. ;;first.
  1. ;;
  1. ;;**End Text**
  1. Q
  1. ;
  1. ;=========================================
  1. IMPLIST(TAXIEN,TERM,CODESYS,NCODES,NLINES,TEXT) ;Build the list for an
  1. ;imported set of codes.
  1. N ACTDT,CODE,DESC,INACTDT,NUM,PDATA,RESULT
  1. S CODE="",(NCODES,NLINES)=0
  1. F S CODE=$O(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q:CODE="" D
  1. . K PDATA
  1. .;DBIA #5679
  1. . S RESULT=$$PERIOD^LEXU(CODE,CODESYS,.PDATA)
  1. . I +RESULT=-1 Q
  1. . S NCODES=NCODES+1
  1. . S (ACTDT,NUM)=0
  1. . F S ACTDT=$O(PDATA(ACTDT)) Q:ACTDT="" D
  1. .. S INACTDT=$P(PDATA(ACTDT),U,1)
  1. .. S DESC=PDATA(ACTDT,0)
  1. .. I CODESYS="SCT" S DESC=DESC_" "_$$SCTHIER^PXRMTXIN(CODE,ACTDT)
  1. .. S NUM=NUM+1
  1. .. S NLINES=NLINES+1
  1. .. I NUM=1 S TEXT(NLINES)=NCODES_U_CODE_U_ACTDT_U_INACTDT_U_DESC
  1. .. E S TEXT(NLINES)=U_U_ACTDT_U_INACTDT_U_DESC
  1. Q
  1. ;
  1. ;=========================================
  1. INCL ;Put the selected entries on the selected list and highlight them.
  1. N SEL,SELLIST
  1. ;Get the list.
  1. D GETLIST(.SELLIST)
  1. ;If there is no list quit.
  1. I '$D(SELLIST) Q
  1. S SEL=""
  1. F S SEL=$O(SELLIST(SEL)) Q:SEL="" D ADDSEL(SEL,"")
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. INCX(LIST,UID) ;Put the selected entries on the selected list and highlight
  1. ;them.
  1. N ENUM,IND
  1. F IND=1:1:$L(LIST,",") D
  1. . S ENUM=$P(LIST,",",IND)
  1. . D ADDSEL(ENUM,UID)
  1. Q
  1. ;
  1. ;=========================================
  1. INITMPG ;Initialize all the ^TMP globals.
  1. K ^TMP("PXRMLEXL",$J)
  1. Q
  1. ;
  1. ;=========================================
  1. LEXLIST(TAXIEN,TERM,CODESYS,NCODES,NLINES,TEXT) ;Call Lexicon to get the list
  1. ;of codes.
  1. I $E(TERM,1,9)="Copy from" D CPLIST(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT) Q
  1. I TERM["(imported)" D IMPLIST(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT) Q
  1. N ACTDT,CODE,CODEI,INACTDT,IND,NUM
  1. N RESULT,SRC,SDESC,TEMP
  1. W @IOF,"Searching Lexicon ..."
  1. K ^TMP("LEXTAX",$J)
  1. ;DBIA #5681
  1. S RESULT=$$TAX^LEX10CS(TERM,CODESYS,DT,"LEXTAX",0)
  1. S NCODES=+RESULT
  1. I NCODES=-1 S (NCODES,NLINES)=0 K ^TMP("LEXTAX",$J) Q
  1. S SRC=+$O(^TMP("LEXTAX",$J,0))
  1. I CODESYS="SCT" D SCTDESC("LEXTAX")
  1. S CODEI="",(NLINES,NUM)=0
  1. F S CODEI=$O(^TMP("LEXTAX",$J,SRC,CODEI)) Q:CODEI="" D
  1. . S NUM=NUM+1,IND=0
  1. . F S IND=$O(^TMP("LEXTAX",$J,SRC,CODEI,IND)) Q:IND="" D
  1. .. S TEMP=^TMP("LEXTAX",$J,SRC,CODEI,IND)
  1. .. S ACTDT=$P(TEMP,U,1),INACTDT=$P(TEMP,U,2)
  1. .. S TEMP=^TMP("LEXTAX",$J,SRC,CODEI,IND,0)
  1. .. S CODE=$P(TEMP,U,1),SDESC=$P(TEMP,U,2)
  1. .. S NLINES=NLINES+1
  1. .. I IND=1 S TEXT(NLINES)=NUM_U_CODE_U_ACTDT_U_INACTDT_U_SDESC
  1. .. E S TEXT(NLINES)=U_U_ACTDT_U_INACTDT_U_SDESC
  1. K ^TMP("LEXTAX",$J)
  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^PXRMLEXL
  1. Q
  1. ;
  1. ;=========================================
  1. RFD(ENUM) ;Remove UID from the selected entry.
  1. N START
  1. S $P(^TMP("PXRMLEXL",$J,"SELECTED",ENUM),U,2)=0
  1. S START=$P(^TMP("PXRMLEXL",$J,"LINES",ENUM),U,1)
  1. D FLDCTRL^VALM10(START,"CODE",IORVOFF,IORVOFF,"")
  1. Q
  1. ;
  1. ;=========================================
  1. RFDL ;Remove UID from the selected entries.
  1. N SEL,SELLIST
  1. ;Get the list.
  1. D GETLIST(.SELLIST)
  1. ;If there is no list quit.
  1. I '$D(SELLIST) Q
  1. S SEL=""
  1. F S SEL=$O(SELLIST(SEL)) Q:SEL="" D RFD(SEL)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. RFDX(LIST) ;Remove UID from the selected entries.
  1. N ENUM,IND
  1. F IND=1:1:$L(LIST,",") D
  1. . S ENUM=$P(LIST,",",IND)
  1. . D RFD(ENUM)
  1. Q
  1. ;
  1. ;=========================================
  1. RFT(ENUM) ;Remove entry ENUM from the selected list and un-highlight it.
  1. K ^TMP("PXRMLEXL",$J,"SELECTED",ENUM)
  1. D HLITE(ENUM,0,0)
  1. Q
  1. ;
  1. ;=========================================
  1. RFTL ;Remove the selected entries from the selected list and un-highlight them.
  1. N SEL,SELLIST
  1. ;Get the list.
  1. D GETLIST(.SELLIST)
  1. ;If there is no list quit.
  1. I '$D(SELLIST) Q
  1. S SEL=""
  1. F S SEL=$O(SELLIST(SEL)) Q:SEL="" D RFT(SEL)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. RFTX(LIST) ;Remove the selected entries from the selected list and un-highlight
  1. ;them.
  1. N ENUM,IND
  1. F IND=1:1:$L(LIST,",") D
  1. . S ENUM=$P(LIST,",",IND)
  1. . D RFT(ENUM)
  1. Q
  1. ;
  1. ;=========================================
  1. SAVE ;Save the selected entries in the taxonomy.
  1. N CODE,CODESYS,ENUM,TEMP,TERM,UID
  1. ;^TMP("PXRMLEXTC",$J) nodes are set in PXRMTXSM which calls this
  1. ;List Manager selection.
  1. S CODESYS=^TMP("PXRMLEXTC",$J,"CODESYS")
  1. S TERM=^TMP("PXRMLEXTC",$J,"LEX TERM")
  1. K ^TMP("PXRMCODES",$J,TERM,CODESYS)
  1. ;Mark this coding system as having been edited so it is not reloaded
  1. ;from the taxonomy in CODELIST^PXRMTXSM.
  1. S ^TMP("PXRMCODES",$J,TERM,CODESYS)=""
  1. S ENUM=0,NSEL=0
  1. F S ENUM=$O(^TMP("PXRMLEXL",$J,"SELECTED",ENUM)) Q:ENUM="" D
  1. . S TEMP=^TMP("PXRMLEXL",$J,"SELECTED",ENUM)
  1. . S CODE=$P(TEMP,U,1),UID=$P(TEMP,U,2)
  1. . S ^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)=UID
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. SCTDESC(NODE) ;Append the SNOMED hierarchy to the description and then
  1. ;sort the list by description.
  1. N ACTDT,CODEI,CODE,DESC,FSN,HE,HIER,HS,NUM,SRC
  1. K ^TMP($J,"DESC"),^TMP($J,"SORT")
  1. S SRC=$O(^TMP(NODE,$J,0))
  1. S CODEI=""
  1. F S CODEI=$O(^TMP(NODE,$J,SRC,CODEI)) Q:CODEI="" D
  1. . S ACTDT=$P(^TMP(NODE,$J,SRC,CODEI,1),U,1)
  1. . S CODE=$P(^TMP(NODE,$J,SRC,CODEI,1,0),U,1)
  1. . S DESC=$P(^TMP(NODE,$J,SRC,CODEI,1,0),U,2)
  1. .;DBIA #5007
  1. . S FSN=$$GETFSN^LEXTRAN1(SRC,CODE,ACTDT)
  1. . S HS=$F(FSN,"(")
  1. . S HE=$F(FSN,")",HS)
  1. . S HIER=$E(FSN,HS-1,HE-1)
  1. . S DESC=DESC_" "_HIER
  1. . S ^TMP($J,"DESC",DESC,CODEI)=""
  1. S DESC="",NUM=0
  1. F S DESC=$O(^TMP($J,"DESC",DESC)) Q:DESC="" D
  1. . S CODEI=""
  1. . F S CODEI=$O(^TMP($J,"DESC",DESC,CODEI)) Q:CODEI="" D
  1. .. S NUM=NUM+1
  1. .. M ^TMP($J,"SORT",SRC,NUM)=^TMP(NODE,$J,SRC,CODEI)
  1. .. S $P(^TMP($J,"SORT",SRC,NUM,1,0),U,2)=DESC
  1. K ^TMP(NODE,$J)
  1. M ^TMP(NODE,$J)=^TMP($J,"SORT")
  1. K ^TMP($J,"DESC"),^TMP($J,"SORT")
  1. Q
  1. ;
  1. ;=========================================
  1. UIDL ;Mark selected entries as UID.
  1. N SEL,SELLIST
  1. ;Get the list.
  1. D GETLIST(.SELLIST)
  1. ;If there is no list quit.
  1. I '$D(SELLIST) Q
  1. S SEL=""
  1. F S SEL=$O(SELLIST(SEL)) Q:SEL="" D ADDSEL(SEL,1)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. UIDOK() ;Check the coding system to determine if it can be used in a dialog.
  1. N CODESYS,UIDOK
  1. S CODESYS=^TMP("PXRMLEXTC",$J,"CODESYS")
  1. S UIDOK=$$UIDOK^PXRMUID(CODESYS)
  1. I UIDOK Q 1
  1. S (XQORQUIT,XQORPOP)=1
  1. Q 0
  1. ;
  1. ;=========================================
  1. XQORM ; Set range for selection.
  1. N NCODES
  1. S NCODES=+$G(^TMP("PXRMLEXL",$J,"NCODES"))
  1. I NCODES=0 Q
  1. S XQORM("#")=$O(^ORD(101,"B","PXRM LEXICON SELECT ENTRY",0))_U_"1:"_NCODES
  1. S XQORM("A")="Select Action: "
  1. Q
  1. ;
  1. ;=========================================
  1. XSEL ;Entry action for protocol PXRM LEXICON SELECT ENTRY.
  1. N ENUM,IND,LIST,LVALID
  1. S LIST=$P(XQORNOD(0),"=",2)
  1. ;Remove trailing ,
  1. I $E(LIST,$L(LIST))="," S LIST=$E(LIST,1,$L(LIST)-1)
  1. S LVALID=1
  1. F IND=1:1:$L(LIST,",") D
  1. . S ENUM=$P(LIST,",",IND)
  1. . I (ENUM<1)!(ENUM>VALMCNT)!('$D(^TMP("PXRMLEXL",$J,"LINES",ENUM))) D
  1. .. W !,ENUM," is not a valid selection."
  1. .. W !,"The range is 1 to ",$O(^TMP("PXRMLEXL",$J,"LINES",""),-1),"."
  1. .. H 2
  1. .. S LVALID=0
  1. I 'LVALID S VALMBCK="R" Q
  1. ;
  1. ;Full screen mode
  1. D FULL^VALM1
  1. ;
  1. ;Possible actions.
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
  1. S DIR(0)="SBM"_U_"ADD:Add to taxonomy;"
  1. S DIR(0)=DIR(0)_"RFT:Remove from taxonomy;"
  1. I $$UIDOK D
  1. . S DIR(0)=DIR(0)_"RFD:Remove from dialog;"
  1. . S DIR(0)=DIR(0)_"UID:Use in dialog;"
  1. S DIR("A")="Select Action: "
  1. S DIR("B")="ADD"
  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="ADD" D INCX^PXRMLEXL(.LIST,0)
  1. I OPTION="RFD" D RFDX^PXRMLEXL(.LIST)
  1. I OPTION="RFT" D RFTX^PXRMLEXL(.LIST)
  1. I OPTION="UID" D INCX^PXRMLEXL(.LIST,1)
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;