PXRMLEXL ;SLC/PKR - List Manager routines for Taxonomies and Lexicon. ;14-Aug-2015 08:20;du
;;2.0;CLINICAL REMINDERS;**26,1005**;Feb 04, 2005;Build 23
;
;=========================================
ADDSEL(ENUM,UID) ;Add entry ENUM to the selected list and highlight it.
N CODE
S CODE=^TMP("PXRMLEXL",$J,"CODE",ENUM)
S ^TMP("PXRMLEXL",$J,"SELECTED",ENUM)=CODE_U_UID
D HLITE(ENUM,1,UID)
Q
;
;=========================================
BLDLIST ;Build the Lexicon list.
N CODE,CODESYS,CODESYSP,DESC,ENUM,FMTSTR,IND,JND
N NCODES,NL,NLINES,NSEL,NUID,NUM,OUTPUT,START,TAXIEN,TERM,TEXT,UID
S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLLL")
;^TMP("PXRMLEXTC",$J) nodes are set in PXRMTXSM which calls this
;List Manager selection.
;Clear the display.
D KILL^VALM10
K ^TMP("PXRMLEXL",$J)
S CODESYS=^TMP("PXRMLEXTC",$J,"CODESYS")
S TAXIEN=^TMP("PXRMLEXTC",$J,"TAX IEN")
S TERM=^TMP("PXRMLEXTC",$J,"LEX TERM")
;Clear the display.
D KILL^VALM10
K ^TMP("PXRMLEXL",$J)
I '$D(^TMP("PXRMLEXS",$J,TERM,CODESYS)) D
. D LEXLIST(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT)
. M ^TMP("PXRMTEXT",$J,TERM,CODESYS,"TEXT")=TEXT
. S ^TMP("PXRMTEXT",$J,TERM,CODESYS,"NCODES")=NCODES
. S ^TMP("PXRMTEXT",$J,TERM,CODESYS,"NLINES")=NLINES
I $D(^TMP("PXRMTEXT",$J,TERM,CODESYS)) D
. S NCODES=^TMP("PXRMTEXT",$J,TERM,CODESYS,"NCODES")
. S NLINES=^TMP("PXRMTEXT",$J,TERM,CODESYS,"NLINES")
;Get the coding system Lexicon information for building the display.
;DBIA #5679
S CODESYSP=$$CSYS^LEXU(CODESYS)
S TEXT=^TMP("PXRMLEXTC",$J,"LEX TERM")
S TEXT=$S(($L(TEXT)'>66):TEXT,1:$E(TEXT,1,63)_"...")
S VALMHDR(1)="Term/Code: "_TEXT
S VALMHDR(2)=NCODES_" "_$P(CODESYSP,U,4)_$S(NCODES=1:" code was found",1:" codes were found")
I NCODES=1,'$$UIDOK S VALMHDR(2)=VALMHDR(2)_" It cannot be used in a dialog."
I NCODES>1,'$$UIDOK S VALMHDR(2)=VALMHDR(2)_" These cannot be used in a dialog."
;Set these so LM shows Page 1 of 1 when there are no codes.
I NCODES=0 S VALMHDR(2)=VALMHDR(2)_".",^TMP("PXRMLEXL",$J,1,0)="",VALMCNT=1 Q
;
;If the display list has been saved restore it, if not build it.
I $D(^TMP("PXRMLEXS",$J,TERM,CODESYS)) D
. M ^TMP("PXRMLEXL",$J)=^TMP("PXRMLEXS",$J,TERM,CODESYS)
. S VALMCNT=^TMP("PXRMLEXS",$J,TERM,CODESYS,"VALMCNT")
I '$D(^TMP("PXRMLEXS",$J,TERM,CODESYS)) D
. S VALMCNT=0
. F IND=1:1:NLINES D
.. S NUM=$P(TEXT(IND),U,1),CODE=$P(TEXT(IND),U,2)
.. I NUM'="",CODE'="" S ENUM=NUM,^TMP("PXRMLEXL",$J,"CODE",NUM)=CODE,START=VALMCNT+1
.. D FORMAT(TEXT(IND),FMTSTR,.NL,.OUTPUT)
.. F JND=1:1:NL D
... S VALMCNT=VALMCNT+1,^TMP("PXRMLEXL",$J,VALMCNT,0)=OUTPUT(JND)
... S ^TMP("PXRMLEXL",$J,"IDX",VALMCNT,ENUM)=""
.. S ^TMP("PXRMLEXL",$J,"LINES",ENUM)=START_U_VALMCNT
. S ^TMP("PXRMLEXL",$J,"NCODES")=NCODES
. S ^TMP("PXRMLEXL",$J,"VALMCNT")=VALMCNT
;If the display list has not been saved, save it.
I '$D(^TMP("PXRMLEXS",$J,TERM,CODESYS)) M ^TMP("PXRMLEXS",$J,TERM,CODESYS)=^TMP("PXRMLEXL",$J)
;
;Mark any entries that were previously selected.
S ENUM="",(NSEL,NUID)=0
F S ENUM=$O(^TMP("PXRMLEXL",$J,"CODE",ENUM)) Q:ENUM="" D
. S CODE=^TMP("PXRMLEXL",$J,"CODE",ENUM)
. I CODE'="",$D(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) D Q
.. S NSEL=NSEL+1
.. S UID=+^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
.. I UID S NUID=NUID+1
.. D ADDSEL(ENUM,UID)
S VALMHDR(2)=VALMHDR(2)_", "_NSEL_" are selected."
S PXRMLEXV="ALL"
I $D(PXRMBGS("ALL")) S VALMBG=PXRMBGS("ALL")
Q
;
;=========================================
BLDSLIST ;Build the Lexicon list, selected or UID codes only.
N CODE,CODESYS,CODESYSP,DONE,FMTSTR,IND,JND,KND
N NL,NSEL,NUID,OUTPUT,START,TERM,TEXT,UID
S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLLL")
;^TMP("PXRMLEXTC",$J) nodes are set in PXRMTXSM which calls this
;List Manager selection.
;Clear the display.
D KILL^VALM10
K ^TMP("PXRMLEXL",$J)
S CODESYS=^TMP("PXRMLEXTC",$J,"CODESYS")
;DBIA #5679
S CODESYSP=$$CSYS^LEXU(CODESYS)
S TERM=^TMP("PXRMLEXTC",$J,"LEX TERM")
S TEXT=^TMP("PXRMLEXTC",$J,"LEX TERM")
S TEXT=$S(($L(TEXT)'>66):TEXT,1:$E(TEXT,1,63)_"...")
;Get the entries that were previously selected.
S NLINES=^TMP("PXRMTEXT",$J,TERM,CODESYS,"NLINES")
S (NSEL,NUID,VALMCNT)=0
F IND=1:1:NLINES D
. S TEMP=^TMP("PXRMTEXT",$J,TERM,CODESYS,"TEXT",IND)
. S CODE=$P(TEMP,U,2)
. I (CODE'=""),'$D(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q
.;Skip additional activation/inactivation lines for non-selected codes.
. I CODE="" Q
. I CODE'="" S UID=^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
. I UID S NUID=NUID+1
. S NSEL=NSEL+1
. S ^TMP("PXRMLEXL",$J,"CODE",NSEL)=CODE,START=VALMCNT+1
. S TEXT=NSEL_U_CODE_U_$P(TEMP,U,3,5)
. D FORMAT(TEXT,FMTSTR,.NL,.OUTPUT)
. F JND=1:1:NL D
.. S VALMCNT=VALMCNT+1,^TMP("PXRMLEXL",$J,VALMCNT,0)=OUTPUT(JND)
.. S ^TMP("PXRMLEXL",$J,"IDX",VALMCNT,NSEL)=""
. ;S ^TMP("PXRMLEXL",$J,"LINES",NSEL)=START_U_VALMCNT
. ;D ADDSEL(NSEL,UID)
.;Check for additional activation/inactivation lines.
. S KND=IND
. S DONE=$S(IND<NLINES:0,1:1)
. F Q:DONE D
.. S KND=KND+1
.. S TEMP=^TMP("PXRMTEXT",$J,TERM,CODESYS,"TEXT",KND)
.. I $P(TEMP,U,2)'="" S DONE=1 Q
.. I KND=NLINES S DONE=1
.. S IND=KND
.. D FORMAT(TEMP,FMTSTR,.NL,.OUTPUT)
.. F JND=1:1:NL D
... S VALMCNT=VALMCNT+1,^TMP("PXRMLEXL",$J,VALMCNT,0)=OUTPUT(JND)
... S ^TMP("PXRMLEXL",$J,"IDX",VALMCNT,NSEL)=""
. S ^TMP("PXRMLEXL",$J,"LINES",NSEL)=START_U_VALMCNT
. D ADDSEL(NSEL,UID)
S ^TMP("PXRMLEXL",$J,"NCODES")=NSEL
S ^TMP("PXRMLEXL",$J,"VALMCNT")=VALMCNT
S VALMHDR(1)="Term/Code: "_TERM
S VALMHDR(2)="Selected "_$P(CODESYSP,U,4)_": "_NSEL_" selected codes, "_NUID_" UID codes."
S PXRMLEXV="SEL"
S VALMBG=$S($D(PXRMBGS("SEL")):PXRMBGS("SEL"),1:1)
Q
;
;=========================================
CPLIST(TAXIEN,TERM,CODESYS,NCODES,NLINES,TEXT) ;Build the list for a copy from
;a range list of codes.
N ACTDT,CODE,DATA,INACTDT,NUM,SDESC,TEMP
S CODE="",(NCODES,NLINES)=0
F S CODE=$O(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q:CODE="" D
. K DATA
.;DBIA #1997, #3991
. I CODESYS="CPC" D PERIOD^ICPTAPIU(CODE,.DATA)
. I CODESYS="CPT" D PERIOD^ICPTAPIU(CODE,.DATA)
. I CODESYS="ICD" D PERIOD^ICDAPIU(CODE,.DATA)
. I CODESYS="ICP" D PERIOD^ICDAPIU(CODE,.DATA)
. I +DATA(0)=-1 Q
. S NCODES=NCODES+1
. S (ACTDT,NUM)=0
. F S ACTDT=$O(DATA(ACTDT)) Q:ACTDT="" D
.. S TEMP=DATA(ACTDT)
.. S NUM=NUM+1
.. S INACTDT=$P(TEMP,U,1)
.. S SDESC=$P(TEMP,U,2)
.. S NLINES=NLINES+1
.. I NUM=1 S TEXT(NLINES)=NCODES_U_CODE_U_ACTDT_U_INACTDT_U_SDESC
.. E S TEXT(NLINES)=U_U_ACTDT_U_INACTDT_U_SDESC
Q
;
;=========================================
ENTRY ;Entry code
D INITMPG^PXRMLEXL
D BLDLIST^PXRMLEXL
D XQORM
Q
;
;=========================================
EXIT ;Exit code
D INITMPG^PXRMLEXL
D FULL^VALM1
D CLEAN^VALM10
D KILL^VALM10
D CLEAR^VALM1
S VALMBCK="Q"
Q
;
;=========================================
EXITS ;Exit and save action.
D SAVE^PXRMLEXL
S VALMBCK="Q"
Q
;
;=========================================
FORMAT(TEXT,FMTSTR,NL,OUTPUT) ;Format entry number, code,
;activation date, inactivation date, short text for LM display.
N ACTDT,INACTDT
S ACTDT=$P(TEXT,U,3),INACTDT=$P(TEXT,U,4)
S ACTDT=$$FMTE^XLFDT(ACTDT,5)
S INACTDT=$$FMTE^XLFDT(INACTDT,5)
S $P(TEXT,U,3)=ACTDT,$P(TEXT,U,4)=INACTDT
D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
Q
;
;=========================================
GETLIST(LIST) ;Let the user input a list of items.
N INUM,ITEM,LEND,LELEM,NCODES,LSTART,X,Y
S NCODES=+$G(^TMP("PXRMLEXL",$J,"NCODES"))
I NCODES=0 Q
I NCODES=1 S LIST(1)="" Q
S DIR(0)="LC^1:"_NCODES
D ^DIR
I $E(Y,1)="^" Q
;Populate the list.
F INUM=1:1:($L(Y,",")-1) D
. S LELEM=$P(Y,",",INUM)
. I LELEM?1.N S LIST(LELEM)=""
. S LSTART=$P(LELEM,"-",1),LEND=$P(LELEM,"-",2)
. F ITEM=LSTART:1:LEND S LIST(ITEM)=""
Q
;
;=========================================
HDR ; Header code
S VALMHDR(1)="Select Lexicon items to include in the taxonomy."
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
;=========================================
HELP ;Display help.
D HELP^BPXRMEXT
Q
;
;=========================================
HLITE(ENUM,MODE,UID) ;Highlight/unhighlight an entry. MODE=1 turns on
;highlighting, MODE=0 turns it off.
N LINE,START,STOP,VCTRL
S VCTRL=$S(MODE=1:IOINHI,1:IOINORM)
S START=$P(^TMP("PXRMLEXL",$J,"LINES",ENUM),U,1)
S STOP=$P(^TMP("PXRMLEXL",$J,"LINES",ENUM),U,2)
F LINE=START:1:STOP D CNTRL^VALM10(LINE,1,80,VCTRL,IOINORM)
;If the entry is marked Use In Dialog turn on marker.
I MODE=1,UID=1 D FLDCTRL^VALM10(START,"CODE",IORVON,IORVOFF,"")
I MODE=0 D FLDCTRL^VALM10(START,"CODE",IORVOFF,IORVOFF,"")
Q
;
;=========================================
IMPLIST(TAXIEN,TERM,CODESYS,NCODES,NLINES,TEXT) ;Build the list for an
;imported set of codes.
D IMPLIST^BPXRMEXT(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT)
Q
;
;=========================================
INCL ;Put the selected entries on the selected list and highlight them.
N SEL,SELLIST
;Get the list.
D GETLIST(.SELLIST)
;If there is no list quit.
I '$D(SELLIST) Q
S SEL=""
F S SEL=$O(SELLIST(SEL)) Q:SEL="" D ADDSEL(SEL,"")
S VALMBCK="R"
Q
;
;=========================================
INCX(LIST,UID) ;Put the selected entries on the selected list and highlight
;them.
N ENUM,IND
F IND=1:1:$L(LIST,",") D
. S ENUM=$P(LIST,",",IND)
. D ADDSEL(ENUM,UID)
Q
;
;=========================================
INITMPG ;Initialize all the ^TMP globals.
K ^TMP("PXRMLEXL",$J)
Q
;
;=========================================
LEXLIST(TAXIEN,TERM,CODESYS,NCODES,NLINES,TEXT) ;Call Lexicon to get the list
;of codes.
I $E(TERM,1,9)="Copy from" D CPLIST(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT) Q
I TERM["(imported)" D IMPLIST(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT) Q
N ACTDT,CODE,CODEI,INACTDT,IND,NUM
N RESULT,SRC,SDESC,TEMP
W @IOF,"Searching Lexicon ..."
K ^TMP("LEXTAX",$J)
;DBIA #5681
S RESULT=$$TAX^LEX10CS(TERM,CODESYS,DT,"LEXTAX",0)
S NCODES=+RESULT
I NCODES=-1 S (NCODES,NLINES)=0 K ^TMP("LEXTAX",$J) Q
S SRC=+$O(^TMP("LEXTAX",$J,0))
I CODESYS="SCT" D SCTDESC("LEXTAX")
S CODEI="",(NLINES,NUM)=0
F S CODEI=$O(^TMP("LEXTAX",$J,SRC,CODEI)) Q:CODEI="" D
. S NUM=NUM+1,IND=0
. F S IND=$O(^TMP("LEXTAX",$J,SRC,CODEI,IND)) Q:IND="" D
.. S TEMP=^TMP("LEXTAX",$J,SRC,CODEI,IND)
.. S ACTDT=$P(TEMP,U,1),INACTDT=$P(TEMP,U,2)
.. S TEMP=^TMP("LEXTAX",$J,SRC,CODEI,IND,0)
.. S CODE=$P(TEMP,U,1),SDESC=$P(TEMP,U,2)
.. S NLINES=NLINES+1
.. I IND=1 S TEXT(NLINES)=NUM_U_CODE_U_ACTDT_U_INACTDT_U_SDESC
.. E S TEXT(NLINES)=U_U_ACTDT_U_INACTDT_U_SDESC
K ^TMP("LEXTAX",$J)
Q
;
;=========================================
PEXIT ; Protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
;Reset after page up/down etc
D XQORM
Q
;
;=========================================
RFD(ENUM) ;Remove UID from the selected entry.
N START
S $P(^TMP("PXRMLEXL",$J,"SELECTED",ENUM),U,2)=0
S START=$P(^TMP("PXRMLEXL",$J,"LINES",ENUM),U,1)
D FLDCTRL^VALM10(START,"CODE",IORVOFF,IORVOFF,"")
Q
;
;=========================================
RFDL ;Remove UID from the selected entries.
N SEL,SELLIST
;Get the list.
D GETLIST(.SELLIST)
;If there is no list quit.
I '$D(SELLIST) Q
S SEL=""
F S SEL=$O(SELLIST(SEL)) Q:SEL="" D RFD(SEL)
S VALMBCK="R"
Q
;
;=========================================
RFDX(LIST) ;Remove UID from the selected entries.
N ENUM,IND
F IND=1:1:$L(LIST,",") D
. S ENUM=$P(LIST,",",IND)
. D RFD(ENUM)
Q
;
;=========================================
RFT(ENUM) ;Remove entry ENUM from the selected list and unhighlight it.
K ^TMP("PXRMLEXL",$J,"SELECTED",ENUM)
D HLITE(ENUM,0,0)
Q
;
;=========================================
RFTL ;Remove the selected entries from the selected list and unhighlight them.
N SEL,SELLIST
;Get the list.
D GETLIST(.SELLIST)
;If there is no list quit.
I '$D(SELLIST) Q
S SEL=""
F S SEL=$O(SELLIST(SEL)) Q:SEL="" D RFT(SEL)
S VALMBCK="R"
Q
;
;=========================================
RFTX(LIST) ;Remove the selected entries from the selected list and unhighlight
;them.
N ENUM,IND
F IND=1:1:$L(LIST,",") D
. S ENUM=$P(LIST,",",IND)
. D RFT(ENUM)
Q
;
;=========================================
SAVE ;Save the selected entries in the taxonomy.
N CODE,CODESYS,ENUM,TEMP,TERM,UID
;^TMP("PXRMLEXTC",$J) nodes are set in PXRMTXSM which calls this
;List Manager selection.
S CODESYS=^TMP("PXRMLEXTC",$J,"CODESYS")
S TERM=^TMP("PXRMLEXTC",$J,"LEX TERM")
K ^TMP("PXRMCODES",$J,TERM,CODESYS)
;Mark this coding system as having been edited so it is not reloaded
;from the taxonomy in CODELIST^PXRMTXSM.
S ^TMP("PXRMCODES",$J,TERM,CODESYS)=""
S ENUM=0,NSEL=0
F S ENUM=$O(^TMP("PXRMLEXL",$J,"SELECTED",ENUM)) Q:ENUM="" D
. S TEMP=^TMP("PXRMLEXL",$J,"SELECTED",ENUM)
. S CODE=$P(TEMP,U,1),UID=$P(TEMP,U,2)
. S ^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)=UID
S VALMBCK="R"
Q
;
;=========================================
SCTDESC(NODE) ;Append the SNOMED hierarchy to the description and then
;sort the list by description.
D SCTDESC^BPXRMEXT(NODE)
Q
;
;=========================================
UIDL ;Mark selected entries as UID.
N SEL,SELLIST
;Get the list.
D GETLIST(.SELLIST)
;If there is no list quit.
I '$D(SELLIST) Q
S SEL=""
F S SEL=$O(SELLIST(SEL)) Q:SEL="" D ADDSEL(SEL,1)
S VALMBCK="R"
Q
;
;=========================================
UIDOK() ;Check the coding system to determine if it can be used in a dialog.
;IHS/MSC/MGH ICD and SNOMEDs turned off to be used in dialogs P1005
N CODESYS
S CODESYS=^TMP("PXRMLEXTC",$J,"CODESYS")
;I CODESYS="10D" Q 1
I CODESYS="CPC" Q 1
I CODESYS="CPT" Q 1
;I CODESYS="ICD" Q 1
;I CODESYS="SCT" Q 1
S (XQORQUIT,XQORPOP)=1
Q 0
;
;=========================================
VIEW() ;Select the view.
S VALMBCK="R"
Q
;I PXRMLEXV="ALL" S PXRMBGS("ALL")=VALMBG D BLDSLIST Q
;I PXRMLEXV="SEL" S PXRMBGS("SEL")=VALMBG D BLDLIST Q
;Q
;
;=========================================
XQORM ; Set range for selection.
N NCODES
S NCODES=+$G(^TMP("PXRMLEXL",$J,"NCODES"))
I NCODES=0 Q
S XQORM("#")=$O(^ORD(101,"B","PXRM LEXICON SELECT ENTRY",0))_U_"1:"_NCODES
S XQORM("A")="Select Action: "
Q
;
;=========================================
XSEL ;Entry action for protocol PXRM LEXICON SELECT ENTRY.
D XSEL^BPXRMEXT
Q
;
PXRMLEXL ;SLC/PKR - List Manager routines for Taxonomies and Lexicon. ;14-Aug-2015 08:20;du
+1 ;;2.0;CLINICAL REMINDERS;**26,1005**;Feb 04, 2005;Build 23
+2 ;
+3 ;=========================================
ADDSEL(ENUM,UID) ;Add entry ENUM to the selected list and highlight it.
+1 NEW CODE
+2 SET CODE=^TMP("PXRMLEXL",$JOB,"CODE",ENUM)
+3 SET ^TMP("PXRMLEXL",$JOB,"SELECTED",ENUM)=CODE_U_UID
+4 DO HLITE(ENUM,1,UID)
+5 QUIT
+6 ;
+7 ;=========================================
BLDLIST ;Build the Lexicon list.
+1 NEW CODE,CODESYS,CODESYSP,DESC,ENUM,FMTSTR,IND,JND
+2 NEW NCODES,NL,NLINES,NSEL,NUID,NUM,OUTPUT,START,TAXIEN,TERM,TEXT,UID
+3 SET FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLLL")
+4 ;^TMP("PXRMLEXTC",$J) nodes are set in PXRMTXSM which calls this
+5 ;List Manager selection.
+6 ;Clear the display.
+7 DO KILL^VALM10
+8 KILL ^TMP("PXRMLEXL",$JOB)
+9 SET CODESYS=^TMP("PXRMLEXTC",$JOB,"CODESYS")
+10 SET TAXIEN=^TMP("PXRMLEXTC",$JOB,"TAX IEN")
+11 SET TERM=^TMP("PXRMLEXTC",$JOB,"LEX TERM")
+12 ;Clear the display.
+13 DO KILL^VALM10
+14 KILL ^TMP("PXRMLEXL",$JOB)
+15 IF '$DATA(^TMP("PXRMLEXS",$JOB,TERM,CODESYS))
Begin DoDot:1
+16 DO LEXLIST(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT)
+17 MERGE ^TMP("PXRMTEXT",$JOB,TERM,CODESYS,"TEXT")=TEXT
+18 SET ^TMP("PXRMTEXT",$JOB,TERM,CODESYS,"NCODES")=NCODES
+19 SET ^TMP("PXRMTEXT",$JOB,TERM,CODESYS,"NLINES")=NLINES
End DoDot:1
+20 IF $DATA(^TMP("PXRMTEXT",$JOB,TERM,CODESYS))
Begin DoDot:1
+21 SET NCODES=^TMP("PXRMTEXT",$JOB,TERM,CODESYS,"NCODES")
+22 SET NLINES=^TMP("PXRMTEXT",$JOB,TERM,CODESYS,"NLINES")
End DoDot:1
+23 ;Get the coding system Lexicon information for building the display.
+24 ;DBIA #5679
+25 SET CODESYSP=$$CSYS^LEXU(CODESYS)
+26 SET TEXT=^TMP("PXRMLEXTC",$JOB,"LEX TERM")
+27 SET TEXT=$SELECT(($LENGTH(TEXT)'>66):TEXT,1:$EXTRACT(TEXT,1,63)_"...")
+28 SET VALMHDR(1)="Term/Code: "_TEXT
+29 SET VALMHDR(2)=NCODES_" "_$PIECE(CODESYSP,U,4)_$SELECT(NCODES=1:" code was found",1:" codes were found")
+30 IF NCODES=1
IF '$$UIDOK
SET VALMHDR(2)=VALMHDR(2)_" It cannot be used in a dialog."
+31 IF NCODES>1
IF '$$UIDOK
SET VALMHDR(2)=VALMHDR(2)_" These cannot be used in a dialog."
+32 ;Set these so LM shows Page 1 of 1 when there are no codes.
+33 IF NCODES=0
SET VALMHDR(2)=VALMHDR(2)_"."
SET ^TMP("PXRMLEXL",$JOB,1,0)=""
SET VALMCNT=1
QUIT
+34 ;
+35 ;If the display list has been saved restore it, if not build it.
+36 IF $DATA(^TMP("PXRMLEXS",$JOB,TERM,CODESYS))
Begin DoDot:1
+37 MERGE ^TMP("PXRMLEXL",$JOB)=^TMP("PXRMLEXS",$JOB,TERM,CODESYS)
+38 SET VALMCNT=^TMP("PXRMLEXS",$JOB,TERM,CODESYS,"VALMCNT")
End DoDot:1
+39 IF '$DATA(^TMP("PXRMLEXS",$JOB,TERM,CODESYS))
Begin DoDot:1
+40 SET VALMCNT=0
+41 FOR IND=1:1:NLINES
Begin DoDot:2
+42 SET NUM=$PIECE(TEXT(IND),U,1)
SET CODE=$PIECE(TEXT(IND),U,2)
+43 IF NUM'=""
IF CODE'=""
SET ENUM=NUM
SET ^TMP("PXRMLEXL",$JOB,"CODE",NUM)=CODE
SET START=VALMCNT+1
+44 DO FORMAT(TEXT(IND),FMTSTR,.NL,.OUTPUT)
+45 FOR JND=1:1:NL
Begin DoDot:3
+46 SET VALMCNT=VALMCNT+1
SET ^TMP("PXRMLEXL",$JOB,VALMCNT,0)=OUTPUT(JND)
+47 SET ^TMP("PXRMLEXL",$JOB,"IDX",VALMCNT,ENUM)=""
End DoDot:3
+48 SET ^TMP("PXRMLEXL",$JOB,"LINES",ENUM)=START_U_VALMCNT
End DoDot:2
+49 SET ^TMP("PXRMLEXL",$JOB,"NCODES")=NCODES
+50 SET ^TMP("PXRMLEXL",$JOB,"VALMCNT")=VALMCNT
End DoDot:1
+51 ;If the display list has not been saved, save it.
+52 IF '$DATA(^TMP("PXRMLEXS",$JOB,TERM,CODESYS))
MERGE ^TMP("PXRMLEXS",$JOB,TERM,CODESYS)=^TMP("PXRMLEXL",$JOB)
+53 ;
+54 ;Mark any entries that were previously selected.
+55 SET ENUM=""
SET (NSEL,NUID)=0
+56 FOR
SET ENUM=$ORDER(^TMP("PXRMLEXL",$JOB,"CODE",ENUM))
IF ENUM=""
QUIT
Begin DoDot:1
+57 SET CODE=^TMP("PXRMLEXL",$JOB,"CODE",ENUM)
+58 IF CODE'=""
IF $DATA(^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE))
Begin DoDot:2
+59 SET NSEL=NSEL+1
+60 SET UID=+^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE)
+61 IF UID
SET NUID=NUID+1
+62 DO ADDSEL(ENUM,UID)
End DoDot:2
QUIT
End DoDot:1
+63 SET VALMHDR(2)=VALMHDR(2)_", "_NSEL_" are selected."
+64 SET PXRMLEXV="ALL"
+65 IF $DATA(PXRMBGS("ALL"))
SET VALMBG=PXRMBGS("ALL")
+66 QUIT
+67 ;
+68 ;=========================================
BLDSLIST ;Build the Lexicon list, selected or UID codes only.
+1 NEW CODE,CODESYS,CODESYSP,DONE,FMTSTR,IND,JND,KND
+2 NEW NL,NSEL,NUID,OUTPUT,START,TERM,TEXT,UID
+3 SET FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLLL")
+4 ;^TMP("PXRMLEXTC",$J) nodes are set in PXRMTXSM which calls this
+5 ;List Manager selection.
+6 ;Clear the display.
+7 DO KILL^VALM10
+8 KILL ^TMP("PXRMLEXL",$JOB)
+9 SET CODESYS=^TMP("PXRMLEXTC",$JOB,"CODESYS")
+10 ;DBIA #5679
+11 SET CODESYSP=$$CSYS^LEXU(CODESYS)
+12 SET TERM=^TMP("PXRMLEXTC",$JOB,"LEX TERM")
+13 SET TEXT=^TMP("PXRMLEXTC",$JOB,"LEX TERM")
+14 SET TEXT=$SELECT(($LENGTH(TEXT)'>66):TEXT,1:$EXTRACT(TEXT,1,63)_"...")
+15 ;Get the entries that were previously selected.
+16 SET NLINES=^TMP("PXRMTEXT",$JOB,TERM,CODESYS,"NLINES")
+17 SET (NSEL,NUID,VALMCNT)=0
+18 FOR IND=1:1:NLINES
Begin DoDot:1
+19 SET TEMP=^TMP("PXRMTEXT",$JOB,TERM,CODESYS,"TEXT",IND)
+20 SET CODE=$PIECE(TEMP,U,2)
+21 IF (CODE'="")
IF '$DATA(^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE))
QUIT
+22 ;Skip additional activation/inactivation lines for non-selected codes.
+23 IF CODE=""
QUIT
+24 IF CODE'=""
SET UID=^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE)
+25 IF UID
SET NUID=NUID+1
+26 SET NSEL=NSEL+1
+27 SET ^TMP("PXRMLEXL",$JOB,"CODE",NSEL)=CODE
SET START=VALMCNT+1
+28 SET TEXT=NSEL_U_CODE_U_$PIECE(TEMP,U,3,5)
+29 DO FORMAT(TEXT,FMTSTR,.NL,.OUTPUT)
+30 FOR JND=1:1:NL
Begin DoDot:2
+31 SET VALMCNT=VALMCNT+1
SET ^TMP("PXRMLEXL",$JOB,VALMCNT,0)=OUTPUT(JND)
+32 SET ^TMP("PXRMLEXL",$JOB,"IDX",VALMCNT,NSEL)=""
End DoDot:2
+33 ;S ^TMP("PXRMLEXL",$J,"LINES",NSEL)=START_U_VALMCNT
+34 ;D ADDSEL(NSEL,UID)
+35 ;Check for additional activation/inactivation lines.
+36 SET KND=IND
+37 SET DONE=$SELECT(IND<NLINES:0,1:1)
+38 FOR
IF DONE
QUIT
Begin DoDot:2
+39 SET KND=KND+1
+40 SET TEMP=^TMP("PXRMTEXT",$JOB,TERM,CODESYS,"TEXT",KND)
+41 IF $PIECE(TEMP,U,2)'=""
SET DONE=1
QUIT
+42 IF KND=NLINES
SET DONE=1
+43 SET IND=KND
+44 DO FORMAT(TEMP,FMTSTR,.NL,.OUTPUT)
+45 FOR JND=1:1:NL
Begin DoDot:3
+46 SET VALMCNT=VALMCNT+1
SET ^TMP("PXRMLEXL",$JOB,VALMCNT,0)=OUTPUT(JND)
+47 SET ^TMP("PXRMLEXL",$JOB,"IDX",VALMCNT,NSEL)=""
End DoDot:3
End DoDot:2
+48 SET ^TMP("PXRMLEXL",$JOB,"LINES",NSEL)=START_U_VALMCNT
+49 DO ADDSEL(NSEL,UID)
End DoDot:1
+50 SET ^TMP("PXRMLEXL",$JOB,"NCODES")=NSEL
+51 SET ^TMP("PXRMLEXL",$JOB,"VALMCNT")=VALMCNT
+52 SET VALMHDR(1)="Term/Code: "_TERM
+53 SET VALMHDR(2)="Selected "_$PIECE(CODESYSP,U,4)_": "_NSEL_" selected codes, "_NUID_" UID codes."
+54 SET PXRMLEXV="SEL"
+55 SET VALMBG=$SELECT($DATA(PXRMBGS("SEL")):PXRMBGS("SEL"),1:1)
+56 QUIT
+57 ;
+58 ;=========================================
CPLIST(TAXIEN,TERM,CODESYS,NCODES,NLINES,TEXT) ;Build the list for a copy from
+1 ;a range list of codes.
+2 NEW ACTDT,CODE,DATA,INACTDT,NUM,SDESC,TEMP
+3 SET CODE=""
SET (NCODES,NLINES)=0
+4 FOR
SET CODE=$ORDER(^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:1
+5 KILL DATA
+6 ;DBIA #1997, #3991
+7 IF CODESYS="CPC"
DO PERIOD^ICPTAPIU(CODE,.DATA)
+8 IF CODESYS="CPT"
DO PERIOD^ICPTAPIU(CODE,.DATA)
+9 IF CODESYS="ICD"
DO PERIOD^ICDAPIU(CODE,.DATA)
+10 IF CODESYS="ICP"
DO PERIOD^ICDAPIU(CODE,.DATA)
+11 IF +DATA(0)=-1
QUIT
+12 SET NCODES=NCODES+1
+13 SET (ACTDT,NUM)=0
+14 FOR
SET ACTDT=$ORDER(DATA(ACTDT))
IF ACTDT=""
QUIT
Begin DoDot:2
+15 SET TEMP=DATA(ACTDT)
+16 SET NUM=NUM+1
+17 SET INACTDT=$PIECE(TEMP,U,1)
+18 SET SDESC=$PIECE(TEMP,U,2)
+19 SET NLINES=NLINES+1
+20 IF NUM=1
SET TEXT(NLINES)=NCODES_U_CODE_U_ACTDT_U_INACTDT_U_SDESC
+21 IF '$TEST
SET TEXT(NLINES)=U_U_ACTDT_U_INACTDT_U_SDESC
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
+24 ;=========================================
ENTRY ;Entry code
+1 DO INITMPG^PXRMLEXL
+2 DO BLDLIST^PXRMLEXL
+3 DO XQORM
+4 QUIT
+5 ;
+6 ;=========================================
EXIT ;Exit code
+1 DO INITMPG^PXRMLEXL
+2 DO FULL^VALM1
+3 DO CLEAN^VALM10
+4 DO KILL^VALM10
+5 DO CLEAR^VALM1
+6 SET VALMBCK="Q"
+7 QUIT
+8 ;
+9 ;=========================================
EXITS ;Exit and save action.
+1 DO SAVE^PXRMLEXL
+2 SET VALMBCK="Q"
+3 QUIT
+4 ;
+5 ;=========================================
FORMAT(TEXT,FMTSTR,NL,OUTPUT) ;Format entry number, code,
+1 ;activation date, inactivation date, short text for LM display.
+2 NEW ACTDT,INACTDT
+3 SET ACTDT=$PIECE(TEXT,U,3)
SET INACTDT=$PIECE(TEXT,U,4)
+4 SET ACTDT=$$FMTE^XLFDT(ACTDT,5)
+5 SET INACTDT=$$FMTE^XLFDT(INACTDT,5)
+6 SET $PIECE(TEXT,U,3)=ACTDT
SET $PIECE(TEXT,U,4)=INACTDT
+7 DO COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
+8 QUIT
+9 ;
+10 ;=========================================
GETLIST(LIST) ;Let the user input a list of items.
+1 NEW INUM,ITEM,LEND,LELEM,NCODES,LSTART,X,Y
+2 SET NCODES=+$GET(^TMP("PXRMLEXL",$JOB,"NCODES"))
+3 IF NCODES=0
QUIT
+4 IF NCODES=1
SET LIST(1)=""
QUIT
+5 SET DIR(0)="LC^1:"_NCODES
+6 DO ^DIR
+7 IF $EXTRACT(Y,1)="^"
QUIT
+8 ;Populate the list.
+9 FOR INUM=1:1:($LENGTH(Y,",")-1)
Begin DoDot:1
+10 SET LELEM=$PIECE(Y,",",INUM)
+11 IF LELEM?1.N
SET LIST(LELEM)=""
+12 SET LSTART=$PIECE(LELEM,"-",1)
SET LEND=$PIECE(LELEM,"-",2)
+13 FOR ITEM=LSTART:1:LEND
SET LIST(ITEM)=""
End DoDot:1
+14 QUIT
+15 ;
+16 ;=========================================
HDR ; Header code
+1 SET VALMHDR(1)="Select Lexicon items to include in the taxonomy."
+2 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+3 QUIT
+4 ;
+5 ;=========================================
HELP ;Display help.
+1 DO HELP^BPXRMEXT
+2 QUIT
+3 ;
+4 ;=========================================
HLITE(ENUM,MODE,UID) ;Highlight/unhighlight an entry. MODE=1 turns on
+1 ;highlighting, MODE=0 turns it off.
+2 NEW LINE,START,STOP,VCTRL
+3 SET VCTRL=$SELECT(MODE=1:IOINHI,1:IOINORM)
+4 SET START=$PIECE(^TMP("PXRMLEXL",$JOB,"LINES",ENUM),U,1)
+5 SET STOP=$PIECE(^TMP("PXRMLEXL",$JOB,"LINES",ENUM),U,2)
+6 FOR LINE=START:1:STOP
DO CNTRL^VALM10(LINE,1,80,VCTRL,IOINORM)
+7 ;If the entry is marked Use In Dialog turn on marker.
+8 IF MODE=1
IF UID=1
DO FLDCTRL^VALM10(START,"CODE",IORVON,IORVOFF,"")
+9 IF MODE=0
DO FLDCTRL^VALM10(START,"CODE",IORVOFF,IORVOFF,"")
+10 QUIT
+11 ;
+12 ;=========================================
IMPLIST(TAXIEN,TERM,CODESYS,NCODES,NLINES,TEXT) ;Build the list for an
+1 ;imported set of codes.
+2 DO IMPLIST^BPXRMEXT(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT)
+3 QUIT
+4 ;
+5 ;=========================================
INCL ;Put the selected entries on the selected list and highlight them.
+1 NEW SEL,SELLIST
+2 ;Get the list.
+3 DO GETLIST(.SELLIST)
+4 ;If there is no list quit.
+5 IF '$DATA(SELLIST)
QUIT
+6 SET SEL=""
+7 FOR
SET SEL=$ORDER(SELLIST(SEL))
IF SEL=""
QUIT
DO ADDSEL(SEL,"")
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
+11 ;=========================================
INCX(LIST,UID) ;Put the selected entries on the selected list and highlight
+1 ;them.
+2 NEW ENUM,IND
+3 FOR IND=1:1:$LENGTH(LIST,",")
Begin DoDot:1
+4 SET ENUM=$PIECE(LIST,",",IND)
+5 DO ADDSEL(ENUM,UID)
End DoDot:1
+6 QUIT
+7 ;
+8 ;=========================================
INITMPG ;Initialize all the ^TMP globals.
+1 KILL ^TMP("PXRMLEXL",$JOB)
+2 QUIT
+3 ;
+4 ;=========================================
LEXLIST(TAXIEN,TERM,CODESYS,NCODES,NLINES,TEXT) ;Call Lexicon to get the list
+1 ;of codes.
+2 IF $EXTRACT(TERM,1,9)="Copy from"
DO CPLIST(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT)
QUIT
+3 IF TERM["(imported)"
DO IMPLIST(TAXIEN,TERM,CODESYS,.NCODES,.NLINES,.TEXT)
QUIT
+4 NEW ACTDT,CODE,CODEI,INACTDT,IND,NUM
+5 NEW RESULT,SRC,SDESC,TEMP
+6 WRITE @IOF,"Searching Lexicon ..."
+7 KILL ^TMP("LEXTAX",$JOB)
+8 ;DBIA #5681
+9 SET RESULT=$$TAX^LEX10CS(TERM,CODESYS,DT,"LEXTAX",0)
+10 SET NCODES=+RESULT
+11 IF NCODES=-1
SET (NCODES,NLINES)=0
KILL ^TMP("LEXTAX",$JOB)
QUIT
+12 SET SRC=+$ORDER(^TMP("LEXTAX",$JOB,0))
+13 IF CODESYS="SCT"
DO SCTDESC("LEXTAX")
+14 SET CODEI=""
SET (NLINES,NUM)=0
+15 FOR
SET CODEI=$ORDER(^TMP("LEXTAX",$JOB,SRC,CODEI))
IF CODEI=""
QUIT
Begin DoDot:1
+16 SET NUM=NUM+1
SET IND=0
+17 FOR
SET IND=$ORDER(^TMP("LEXTAX",$JOB,SRC,CODEI,IND))
IF IND=""
QUIT
Begin DoDot:2
+18 SET TEMP=^TMP("LEXTAX",$JOB,SRC,CODEI,IND)
+19 SET ACTDT=$PIECE(TEMP,U,1)
SET INACTDT=$PIECE(TEMP,U,2)
+20 SET TEMP=^TMP("LEXTAX",$JOB,SRC,CODEI,IND,0)
+21 SET CODE=$PIECE(TEMP,U,1)
SET SDESC=$PIECE(TEMP,U,2)
+22 SET NLINES=NLINES+1
+23 IF IND=1
SET TEXT(NLINES)=NUM_U_CODE_U_ACTDT_U_INACTDT_U_SDESC
+24 IF '$TEST
SET TEXT(NLINES)=U_U_ACTDT_U_INACTDT_U_SDESC
End DoDot:2
End DoDot:1
+25 KILL ^TMP("LEXTAX",$JOB)
+26 QUIT
+27 ;
+28 ;=========================================
PEXIT ; Protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 ;Reset after page up/down etc
+3 DO XQORM
+4 QUIT
+5 ;
+6 ;=========================================
RFD(ENUM) ;Remove UID from the selected entry.
+1 NEW START
+2 SET $PIECE(^TMP("PXRMLEXL",$JOB,"SELECTED",ENUM),U,2)=0
+3 SET START=$PIECE(^TMP("PXRMLEXL",$JOB,"LINES",ENUM),U,1)
+4 DO FLDCTRL^VALM10(START,"CODE",IORVOFF,IORVOFF,"")
+5 QUIT
+6 ;
+7 ;=========================================
RFDL ;Remove UID from the selected entries.
+1 NEW SEL,SELLIST
+2 ;Get the list.
+3 DO GETLIST(.SELLIST)
+4 ;If there is no list quit.
+5 IF '$DATA(SELLIST)
QUIT
+6 SET SEL=""
+7 FOR
SET SEL=$ORDER(SELLIST(SEL))
IF SEL=""
QUIT
DO RFD(SEL)
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
+11 ;=========================================
RFDX(LIST) ;Remove UID from the selected entries.
+1 NEW ENUM,IND
+2 FOR IND=1:1:$LENGTH(LIST,",")
Begin DoDot:1
+3 SET ENUM=$PIECE(LIST,",",IND)
+4 DO RFD(ENUM)
End DoDot:1
+5 QUIT
+6 ;
+7 ;=========================================
RFT(ENUM) ;Remove entry ENUM from the selected list and unhighlight it.
+1 KILL ^TMP("PXRMLEXL",$JOB,"SELECTED",ENUM)
+2 DO HLITE(ENUM,0,0)
+3 QUIT
+4 ;
+5 ;=========================================
RFTL ;Remove the selected entries from the selected list and unhighlight them.
+1 NEW SEL,SELLIST
+2 ;Get the list.
+3 DO GETLIST(.SELLIST)
+4 ;If there is no list quit.
+5 IF '$DATA(SELLIST)
QUIT
+6 SET SEL=""
+7 FOR
SET SEL=$ORDER(SELLIST(SEL))
IF SEL=""
QUIT
DO RFT(SEL)
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
+11 ;=========================================
RFTX(LIST) ;Remove the selected entries from the selected list and unhighlight
+1 ;them.
+2 NEW ENUM,IND
+3 FOR IND=1:1:$LENGTH(LIST,",")
Begin DoDot:1
+4 SET ENUM=$PIECE(LIST,",",IND)
+5 DO RFT(ENUM)
End DoDot:1
+6 QUIT
+7 ;
+8 ;=========================================
SAVE ;Save the selected entries in the taxonomy.
+1 NEW CODE,CODESYS,ENUM,TEMP,TERM,UID
+2 ;^TMP("PXRMLEXTC",$J) nodes are set in PXRMTXSM which calls this
+3 ;List Manager selection.
+4 SET CODESYS=^TMP("PXRMLEXTC",$JOB,"CODESYS")
+5 SET TERM=^TMP("PXRMLEXTC",$JOB,"LEX TERM")
+6 KILL ^TMP("PXRMCODES",$JOB,TERM,CODESYS)
+7 ;Mark this coding system as having been edited so it is not reloaded
+8 ;from the taxonomy in CODELIST^PXRMTXSM.
+9 SET ^TMP("PXRMCODES",$JOB,TERM,CODESYS)=""
+10 SET ENUM=0
SET NSEL=0
+11 FOR
SET ENUM=$ORDER(^TMP("PXRMLEXL",$JOB,"SELECTED",ENUM))
IF ENUM=""
QUIT
Begin DoDot:1
+12 SET TEMP=^TMP("PXRMLEXL",$JOB,"SELECTED",ENUM)
+13 SET CODE=$PIECE(TEMP,U,1)
SET UID=$PIECE(TEMP,U,2)
+14 SET ^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE)=UID
End DoDot:1
+15 SET VALMBCK="R"
+16 QUIT
+17 ;
+18 ;=========================================
SCTDESC(NODE) ;Append the SNOMED hierarchy to the description and then
+1 ;sort the list by description.
+2 DO SCTDESC^BPXRMEXT(NODE)
+3 QUIT
+4 ;
+5 ;=========================================
UIDL ;Mark selected entries as UID.
+1 NEW SEL,SELLIST
+2 ;Get the list.
+3 DO GETLIST(.SELLIST)
+4 ;If there is no list quit.
+5 IF '$DATA(SELLIST)
QUIT
+6 SET SEL=""
+7 FOR
SET SEL=$ORDER(SELLIST(SEL))
IF SEL=""
QUIT
DO ADDSEL(SEL,1)
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
+11 ;=========================================
UIDOK() ;Check the coding system to determine if it can be used in a dialog.
+1 ;IHS/MSC/MGH ICD and SNOMEDs turned off to be used in dialogs P1005
+2 NEW CODESYS
+3 SET CODESYS=^TMP("PXRMLEXTC",$JOB,"CODESYS")
+4 ;I CODESYS="10D" Q 1
+5 IF CODESYS="CPC"
QUIT 1
+6 IF CODESYS="CPT"
QUIT 1
+7 ;I CODESYS="ICD" Q 1
+8 ;I CODESYS="SCT" Q 1
+9 SET (XQORQUIT,XQORPOP)=1
+10 QUIT 0
+11 ;
+12 ;=========================================
VIEW() ;Select the view.
+1 SET VALMBCK="R"
+2 QUIT
+3 ;I PXRMLEXV="ALL" S PXRMBGS("ALL")=VALMBG D BLDSLIST Q
+4 ;I PXRMLEXV="SEL" S PXRMBGS("SEL")=VALMBG D BLDLIST Q
+5 ;Q
+6 ;
+7 ;=========================================
XQORM ; Set range for selection.
+1 NEW NCODES
+2 SET NCODES=+$GET(^TMP("PXRMLEXL",$JOB,"NCODES"))
+3 IF NCODES=0
QUIT
+4 SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM LEXICON SELECT ENTRY",0))_U_"1:"_NCODES
+5 SET XQORM("A")="Select Action: "
+6 QUIT
+7 ;
+8 ;=========================================
XSEL ;Entry action for protocol PXRM LEXICON SELECT ENTRY.
+1 DO XSEL^BPXRMEXT
+2 QUIT
+3 ;
