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

PXLEXS.m

Go to the documentation of this file.
  1. PXLEXS ;SLC/PKR - List Manager routines for Lexicon code selection. ;08/01/2017
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
  1. ;
  1. ;=========================================
  1. ADDSEL(ENUM) ;Add entry ENUM to the selected list and highlight it.
  1. N CODE
  1. S CODE=^TMP("PXLEXL",$J,"CODE",ENUM)
  1. S ^TMP("PXLEXL",$J,"SELECTED",ENUM)=CODE
  1. D HLITE(ENUM,1)
  1. Q
  1. ;
  1. ;=========================================
  1. BLDLIST ;Build the Lexicon list.
  1. N ACTIVE,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. ;List Manager selection.
  1. ;Clear the display.
  1. D KILL^VALM10
  1. K ^TMP("PXLEXL",$J)
  1. S CODESYS=^TMP("PXLEXT",$J,"CODING SYSTEM")
  1. S TERM=^TMP("PXLEXT",$J,"SEARCH TERM")
  1. S EVENTDT=^TMP("PXLEXT",$J,"EVENT D/T")
  1. S ACTIVE=^TMP("PXLEXT",$J,"ACTIVE")
  1. ;Clear the display.
  1. D KILL^VALM10
  1. K ^TMP("PXLEXL",$J)
  1. D LEXLIST(TERM,CODESYS,EVENTDT,.NCODES,.NLINES,.TEXT,ACTIVE)
  1. ;Get the coding system Lexicon information for building the display.
  1. ;ICR #5679
  1. S CODESYSP=$$CSYS^LEXU(CODESYS)
  1. S TEXT=^TMP("PXLEXT",$J,"SEARCH 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. ;Set these so LM shows Page 1 of 1 when there are no codes.
  1. I NCODES=0 S VALMHDR(2)=VALMHDR(2)_".",^TMP("PXLEXL",$J,1,0)="",VALMCNT=1 Q
  1. ;
  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("PXLEXL",$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("PXLEXL",$J,VALMCNT,0)=OUTPUT(JND)
  1. .. S ^TMP("PXLEXL",$J,"IDX",VALMCNT,ENUM)=""
  1. . S ^TMP("PXLEXL",$J,"LINES",ENUM)=START_U_VALMCNT
  1. S ^TMP("PXLEXL",$J,"NCODES")=NCODES
  1. S ^TMP("PXLEXL",$J,"VALMCNT")=VALMCNT
  1. Q
  1. ;
  1. ;=========================================
  1. ENTRY ;Entry code
  1. D INITMPG^PXLEXS
  1. D BLDLIST^PXLEXS
  1. D XQORM
  1. Q
  1. ;
  1. ;=========================================
  1. EXIT ;Exit code
  1. M ^TMP("PXLEXT",$J,"SELECTED CODES")=^TMP("PXLEXL",$J,"SELECTED")
  1. D INITMPG^PXLEXS
  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. 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. GETCODE(CODESYS,SRCHTERM,EVENTDT,ACTIVE) ;Given a coding system and search term,
  1. ;display a list of matches so the user can make a single selection.
  1. N CODE,SELECTED
  1. K ^TMP("PXLEXT",$J)
  1. S ^TMP("PXLEXT",$J,"CODING SYSTEM")=CODESYS
  1. S ^TMP("PXLEXT",$J,"SEARCH TERM")=SRCHTERM
  1. S ^TMP("PXLEXT",$J,"EVENT D/T")=EVENTDT
  1. S ^TMP("PXLEXT",$J,"SINGLE")=1
  1. ;ACTIVE=1, return only active codes; ACTIVE=0, active and inactive.
  1. S ^TMP("PXLEXT",$J,"ACTIVE")=ACTIVE
  1. D EN^VALM("PXCE STANDARD CODES SELECT")
  1. S SELECTED=$O(^TMP("PXLEXT",$J,"SELECTED CODES",""))
  1. S CODE=$S(SELECTED="":"",1:^TMP("PXLEXT",$J,"SELECTED CODES",SELECTED))
  1. K ^TMP("PXLEXT",$J)
  1. Q CODE
  1. ;
  1. ;=========================================
  1. GETCODES(CODESYS,SRCHTERM,EVENTDT,CODELIST,ACTIVE) ;Given a coding system and
  1. ;a search term, display a list of matches so the user can make a
  1. ;selection.
  1. K ^TMP("PXLEXT",$J)
  1. S ^TMP("PXLEXT",$J,"CODING SYSTEM")=CODESYS
  1. S ^TMP("PXLEXT",$J,"SEARCH TERM")=SRCHTERM
  1. S ^TMP("PXLEXT",$J,"EVENT D/T")=EVENTDT
  1. S ^TMP("PXLEXT",$J,"ACTIVE")=ACTIVE
  1. D EN^VALM("PXCE STANDARD CODES SELECT")
  1. M CODELIST=^TMP("PXLEXT",$J,"SELECTED CODES")
  1. K ^TMP("PXLEXT",$J)
  1. Q
  1. ;
  1. ;=========================================
  1. GETLIST(LIST) ;Let the user input a list of items.
  1. N DIR,DIR0,INUM,ITEM,LEND,LELEM,NCODES,LSTART,X,Y
  1. S NCODES=+$G(^TMP("PXLEXL",$J,"NCODES"))
  1. I NCODES=0 Q
  1. I NCODES=1 S LIST(1)="" Q
  1. S DIR0=$S($D(^TMP("PXLEXT",$J,"SINGLE")):"N^1:"_NCODES_":0",1:"LC^1:"_NCODES)
  1. S DIR(0)=DIR0
  1. D ^DIR
  1. I $E(Y,1)="^" Q
  1. I Y?1.N S LIST(Y)="" 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 the standard code(s)."
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. Q
  1. ;
  1. ;=========================================
  1. HELP ;Display help.
  1. N DDS,DIR0,DONE,IND,HTEXT,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 HTEXT=$S($D(^TMP("PXLEXT",$J,"SINGLE")):"HTEXTS",1:"HTEXT")
  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) ;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("PXLEXL",$J,"LINES",ENUM),U,1)
  1. S STOP=$P(^TMP("PXLEXL",$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=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. ;; SEL - Select codes to add to the encounter.
  1. ;; REM - Removes selected codes from the encounter.
  1. ;;
  1. ;;When you exit by typing 'Q' the selected codes will be added to or removed
  1. ;;from the encounter depending on the chosen action.
  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. HTEXTS ;Lexicon single selection help text.
  1. ;;Select one of the following actions:
  1. ;;
  1. ;; SEL - Select a code to add to the encounter.
  1. ;; REM - Remove a code from the encounter.
  1. ;;
  1. ;;When you exit by typing 'Q' the selected code will be added to or removed
  1. ;;from the encounter depending on the chosen action.
  1. ;;
  1. ;;You can select the action first and then be prompted for a code or you
  1. ;;can select a code and then select the action.
  1. ;;
  1. ;;**End Text**
  1. Q
  1. ;
  1. ;=========================================
  1. INITMPG ;Initialize all the ^TMP globals.
  1. K ^TMP("PXLEXL",$J)
  1. Q
  1. ;
  1. ;=========================================
  1. LEXLIST(TERM,CODESYS,EVENTDT,NCODES,NLINES,TEXT,ACTIVE) ;Call Lexicon to get
  1. ;the list of codes.
  1. N ACTDT,CODE,CODEI,INACTDT,IND,NUM
  1. N RESULT,SRC,SDESC,TEMP
  1. W @IOF,"Searching Lexicon ..."
  1. K ^TMP("PXLEX",$J)
  1. ;DBIA #5681
  1. S RESULT=$$TAX^LEX10CS(TERM,CODESYS,EVENTDT,"PXLEX",ACTIVE)
  1. S NCODES=+RESULT
  1. I NCODES=-1 S (NCODES,NLINES)=0 K ^TMP("PXLEX",$J) Q
  1. I CODESYS="SCT" D SCTDESC("PXLEX")
  1. S SRC=0
  1. S (NLINES,NUM)=0
  1. F S SRC=$O(^TMP("PXLEX",$J,SRC)) Q:SRC="" D
  1. . S CODEI=""
  1. . F S CODEI=$O(^TMP("PXLEX",$J,SRC,CODEI)) Q:CODEI="" D
  1. .. S NUM=NUM+1,IND=0
  1. .. F S IND=$O(^TMP("PXLEX",$J,SRC,CODEI,IND)) Q:IND="" D
  1. ... S TEMP=^TMP("PXLEX",$J,SRC,CODEI,IND)
  1. ... S ACTDT=$P(TEMP,U,1),INACTDT=$P(TEMP,U,2)
  1. ... S TEMP=^TMP("PXLEX",$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("PXLEX",$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
  1. Q
  1. ;
  1. ;=========================================
  1. REM(ENUM) ;Remove entry ENUM from the selected list and un-highlight it.
  1. K ^TMP("PXLEXL",$J,"SELECTED",ENUM)
  1. D HLITE(ENUM,0)
  1. Q
  1. ;
  1. ;=========================================
  1. REML ;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 REM(SEL)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. REMX(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 REM(ENUM)
  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. SELL ;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. SELX(LIST) ;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)
  1. Q
  1. ;
  1. ;=========================================
  1. XQORM ; Set range for selection.
  1. N NCODES
  1. S NCODES=+$G(^TMP("PXLEXL",$J,"NCODES"))
  1. I NCODES=0 Q
  1. S XQORM("#")=$O(^ORD(101,"B","PXCE LEXICON SELECT ENTRY",0))_U_"1:"_NCODES
  1. S XQORM("A")="Select Action: "
  1. Q
  1. ;
  1. ;=========================================
  1. XSEL ;Entry action for protocol PXCE 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("PXLEXL",$J,"LINES",ENUM))) D
  1. .. W !,ENUM," is not a valid selection."
  1. .. W !,"The range is 1 to ",$O(^TMP("PXLEXL",$J,"LINES",""),-1),"."
  1. .. H 2
  1. .. S LVALID=0
  1. I $D(^TMP("PXLEXT",$J,"SINGLE")),LIST'?1.N D
  1. . W !,"Only a single code can be selected."
  1. . S LVALID=0
  1. . H 2
  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_"SEL:Select code(s);"
  1. S DIR(0)=DIR(0)_"REM:Remove code(s);"
  1. S DIR("A")="Select Action: "
  1. S DIR("B")="SEL"
  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="SEL" D SELX^PXLEXS(.LIST)
  1. I OPTION="REM" D REMX^PXLEXS(.LIST)
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;