- PXLEXS ;SLC/PKR - List Manager routines for Lexicon code selection. ;08/01/2017
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
- ;
- ;=========================================
- ADDSEL(ENUM) ;Add entry ENUM to the selected list and highlight it.
- N CODE
- S CODE=^TMP("PXLEXL",$J,"CODE",ENUM)
- S ^TMP("PXLEXL",$J,"SELECTED",ENUM)=CODE
- D HLITE(ENUM,1)
- Q
- ;
- ;=========================================
- BLDLIST ;Build the Lexicon list.
- N ACTIVE,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")
- ;List Manager selection.
- ;Clear the display.
- D KILL^VALM10
- K ^TMP("PXLEXL",$J)
- S CODESYS=^TMP("PXLEXT",$J,"CODING SYSTEM")
- S TERM=^TMP("PXLEXT",$J,"SEARCH TERM")
- S EVENTDT=^TMP("PXLEXT",$J,"EVENT D/T")
- S ACTIVE=^TMP("PXLEXT",$J,"ACTIVE")
- ;Clear the display.
- D KILL^VALM10
- K ^TMP("PXLEXL",$J)
- D LEXLIST(TERM,CODESYS,EVENTDT,.NCODES,.NLINES,.TEXT,ACTIVE)
- ;Get the coding system Lexicon information for building the display.
- ;ICR #5679
- S CODESYSP=$$CSYS^LEXU(CODESYS)
- S TEXT=^TMP("PXLEXT",$J,"SEARCH 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")
- ;Set these so LM shows Page 1 of 1 when there are no codes.
- I NCODES=0 S VALMHDR(2)=VALMHDR(2)_".",^TMP("PXLEXL",$J,1,0)="",VALMCNT=1 Q
- ;
- 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("PXLEXL",$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("PXLEXL",$J,VALMCNT,0)=OUTPUT(JND)
- .. S ^TMP("PXLEXL",$J,"IDX",VALMCNT,ENUM)=""
- . S ^TMP("PXLEXL",$J,"LINES",ENUM)=START_U_VALMCNT
- S ^TMP("PXLEXL",$J,"NCODES")=NCODES
- S ^TMP("PXLEXL",$J,"VALMCNT")=VALMCNT
- Q
- ;
- ;=========================================
- ENTRY ;Entry code
- D INITMPG^PXLEXS
- D BLDLIST^PXLEXS
- D XQORM
- Q
- ;
- ;=========================================
- EXIT ;Exit code
- M ^TMP("PXLEXT",$J,"SELECTED CODES")=^TMP("PXLEXL",$J,"SELECTED")
- D INITMPG^PXLEXS
- D FULL^VALM1
- D CLEAN^VALM10
- D KILL^VALM10
- D CLEAR^VALM1
- 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
- ;
- ;=========================================
- GETCODE(CODESYS,SRCHTERM,EVENTDT,ACTIVE) ;Given a coding system and search term,
- ;display a list of matches so the user can make a single selection.
- N CODE,SELECTED
- K ^TMP("PXLEXT",$J)
- S ^TMP("PXLEXT",$J,"CODING SYSTEM")=CODESYS
- S ^TMP("PXLEXT",$J,"SEARCH TERM")=SRCHTERM
- S ^TMP("PXLEXT",$J,"EVENT D/T")=EVENTDT
- S ^TMP("PXLEXT",$J,"SINGLE")=1
- ;ACTIVE=1, return only active codes; ACTIVE=0, active and inactive.
- S ^TMP("PXLEXT",$J,"ACTIVE")=ACTIVE
- D EN^VALM("PXCE STANDARD CODES SELECT")
- S SELECTED=$O(^TMP("PXLEXT",$J,"SELECTED CODES",""))
- S CODE=$S(SELECTED="":"",1:^TMP("PXLEXT",$J,"SELECTED CODES",SELECTED))
- K ^TMP("PXLEXT",$J)
- Q CODE
- ;
- ;=========================================
- GETCODES(CODESYS,SRCHTERM,EVENTDT,CODELIST,ACTIVE) ;Given a coding system and
- ;a search term, display a list of matches so the user can make a
- ;selection.
- K ^TMP("PXLEXT",$J)
- S ^TMP("PXLEXT",$J,"CODING SYSTEM")=CODESYS
- S ^TMP("PXLEXT",$J,"SEARCH TERM")=SRCHTERM
- S ^TMP("PXLEXT",$J,"EVENT D/T")=EVENTDT
- S ^TMP("PXLEXT",$J,"ACTIVE")=ACTIVE
- D EN^VALM("PXCE STANDARD CODES SELECT")
- M CODELIST=^TMP("PXLEXT",$J,"SELECTED CODES")
- K ^TMP("PXLEXT",$J)
- Q
- ;
- ;=========================================
- GETLIST(LIST) ;Let the user input a list of items.
- N DIR,DIR0,INUM,ITEM,LEND,LELEM,NCODES,LSTART,X,Y
- S NCODES=+$G(^TMP("PXLEXL",$J,"NCODES"))
- I NCODES=0 Q
- I NCODES=1 S LIST(1)="" Q
- S DIR0=$S($D(^TMP("PXLEXT",$J,"SINGLE")):"N^1:"_NCODES_":0",1:"LC^1:"_NCODES)
- S DIR(0)=DIR0
- D ^DIR
- I $E(Y,1)="^" Q
- I Y?1.N S LIST(Y)="" 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 the standard code(s)."
- S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- Q
- ;
- ;=========================================
- HELP ;Display help.
- N DDS,DIR0,DONE,IND,HTEXT,TEXT
- ;DBIA #5746 covers kill and set of DDS. DDS needs to be set or the
- ;Browser will kill some ScreenMan variables.
- S HTEXT=$S($D(^TMP("PXLEXT",$J,"SINGLE")):"HTEXTS",1:"HTEXT")
- 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","Lexicon Selection Help")
- S VALMBCK="R"
- Q
- ;
- ;=========================================
- HLITE(ENUM,MODE) ;Highlight/un-highlight 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("PXLEXL",$J,"LINES",ENUM),U,1)
- S STOP=$P(^TMP("PXLEXL",$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=0 D FLDCTRL^VALM10(START,"CODE",IORVOFF,IORVOFF,"")
- Q
- ;
- ;=========================================
- HTEXT ;Lexicon selection help text.
- ;;Select one of the following actions:
- ;;
- ;; SEL - Select codes to add to the encounter.
- ;; REM - Removes selected codes from the encounter.
- ;;
- ;;When you exit by typing 'Q' the selected codes will be added to or removed
- ;;from the encounter depending on the chosen action.
- ;;
- ;;You can select the action first and then be prompted for a list of codes or
- ;;you can input the list and then select the action. Because of the way List
- ;;Manager works, you may be able to select a larger list by selecting the action
- ;;first.
- ;;
- ;;**End Text**
- Q
- ;=========================================
- HTEXTS ;Lexicon single selection help text.
- ;;Select one of the following actions:
- ;;
- ;; SEL - Select a code to add to the encounter.
- ;; REM - Remove a code from the encounter.
- ;;
- ;;When you exit by typing 'Q' the selected code will be added to or removed
- ;;from the encounter depending on the chosen action.
- ;;
- ;;You can select the action first and then be prompted for a code or you
- ;;can select a code and then select the action.
- ;;
- ;;**End Text**
- Q
- ;
- ;=========================================
- INITMPG ;Initialize all the ^TMP globals.
- K ^TMP("PXLEXL",$J)
- Q
- ;
- ;=========================================
- LEXLIST(TERM,CODESYS,EVENTDT,NCODES,NLINES,TEXT,ACTIVE) ;Call Lexicon to get
- ;the list of codes.
- N ACTDT,CODE,CODEI,INACTDT,IND,NUM
- N RESULT,SRC,SDESC,TEMP
- W @IOF,"Searching Lexicon ..."
- K ^TMP("PXLEX",$J)
- ;DBIA #5681
- S RESULT=$$TAX^LEX10CS(TERM,CODESYS,EVENTDT,"PXLEX",ACTIVE)
- S NCODES=+RESULT
- I NCODES=-1 S (NCODES,NLINES)=0 K ^TMP("PXLEX",$J) Q
- I CODESYS="SCT" D SCTDESC("PXLEX")
- S SRC=0
- S (NLINES,NUM)=0
- F S SRC=$O(^TMP("PXLEX",$J,SRC)) Q:SRC="" D
- . S CODEI=""
- . F S CODEI=$O(^TMP("PXLEX",$J,SRC,CODEI)) Q:CODEI="" D
- .. S NUM=NUM+1,IND=0
- .. F S IND=$O(^TMP("PXLEX",$J,SRC,CODEI,IND)) Q:IND="" D
- ... S TEMP=^TMP("PXLEX",$J,SRC,CODEI,IND)
- ... S ACTDT=$P(TEMP,U,1),INACTDT=$P(TEMP,U,2)
- ... S TEMP=^TMP("PXLEX",$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("PXLEX",$J)
- Q
- ;
- ;=========================================
- PEXIT ; Protocol exit code
- S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- ;Reset after page up/down etc
- D XQORM
- Q
- ;
- ;=========================================
- REM(ENUM) ;Remove entry ENUM from the selected list and un-highlight it.
- K ^TMP("PXLEXL",$J,"SELECTED",ENUM)
- D HLITE(ENUM,0)
- Q
- ;
- ;=========================================
- REML ;Remove the selected entries from the selected list and un-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 REM(SEL)
- S VALMBCK="R"
- Q
- ;
- ;=========================================
- REMX(LIST) ;Remove the selected entries from the selected list and un-highlight
- ;them.
- N ENUM,IND
- F IND=1:1:$L(LIST,",") D
- . S ENUM=$P(LIST,",",IND)
- . D REM(ENUM)
- Q
- ;
- ;=========================================
- SCTDESC(NODE) ;Append the SNOMED hierarchy to the description and then
- ;sort the list by description.
- N ACTDT,CODEI,CODE,DESC,FSN,HE,HIER,HS,NUM,SRC
- K ^TMP($J,"DESC"),^TMP($J,"SORT")
- S SRC=$O(^TMP(NODE,$J,0))
- S CODEI=""
- F S CODEI=$O(^TMP(NODE,$J,SRC,CODEI)) Q:CODEI="" D
- . S ACTDT=$P(^TMP(NODE,$J,SRC,CODEI,1),U,1)
- . S CODE=$P(^TMP(NODE,$J,SRC,CODEI,1,0),U,1)
- . S DESC=$P(^TMP(NODE,$J,SRC,CODEI,1,0),U,2)
- .;DBIA #5007
- . S FSN=$$GETFSN^LEXTRAN1(SRC,CODE,ACTDT)
- . S HS=$F(FSN,"(")
- . S HE=$F(FSN,")",HS)
- . S HIER=$E(FSN,HS-1,HE-1)
- . S DESC=DESC_" "_HIER
- . S ^TMP($J,"DESC",DESC,CODEI)=""
- S DESC="",NUM=0
- F S DESC=$O(^TMP($J,"DESC",DESC)) Q:DESC="" D
- . S CODEI=""
- . F S CODEI=$O(^TMP($J,"DESC",DESC,CODEI)) Q:CODEI="" D
- .. S NUM=NUM+1
- .. M ^TMP($J,"SORT",SRC,NUM)=^TMP(NODE,$J,SRC,CODEI)
- .. S $P(^TMP($J,"SORT",SRC,NUM,1,0),U,2)=DESC
- K ^TMP(NODE,$J)
- M ^TMP(NODE,$J)=^TMP($J,"SORT")
- K ^TMP($J,"DESC"),^TMP($J,"SORT")
- Q
- ;
- ;=========================================
- SELL ;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
- ;
- ;=========================================
- SELX(LIST) ;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)
- Q
- ;
- ;=========================================
- XQORM ; Set range for selection.
- N NCODES
- S NCODES=+$G(^TMP("PXLEXL",$J,"NCODES"))
- I NCODES=0 Q
- S XQORM("#")=$O(^ORD(101,"B","PXCE LEXICON SELECT ENTRY",0))_U_"1:"_NCODES
- S XQORM("A")="Select Action: "
- Q
- ;
- ;=========================================
- XSEL ;Entry action for protocol PXCE LEXICON SELECT ENTRY.
- N ENUM,IND,LIST,LVALID
- S LIST=$P(XQORNOD(0),"=",2)
- ;Remove trailing ,
- I $E(LIST,$L(LIST))="," S LIST=$E(LIST,1,$L(LIST)-1)
- S LVALID=1
- F IND=1:1:$L(LIST,",") D
- . S ENUM=$P(LIST,",",IND)
- . I (ENUM<1)!(ENUM>VALMCNT)!('$D(^TMP("PXLEXL",$J,"LINES",ENUM))) D
- .. W !,ENUM," is not a valid selection."
- .. W !,"The range is 1 to ",$O(^TMP("PXLEXL",$J,"LINES",""),-1),"."
- .. H 2
- .. S LVALID=0
- I $D(^TMP("PXLEXT",$J,"SINGLE")),LIST'?1.N D
- . W !,"Only a single code can be selected."
- . S LVALID=0
- . H 2
- I 'LVALID S VALMBCK="R" Q
- ;
- ;Full screen mode
- D FULL^VALM1
- ;
- ;Possible actions.
- N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
- S DIR(0)="SBM"_U_"SEL:Select code(s);"
- S DIR(0)=DIR(0)_"REM:Remove code(s);"
- S DIR("A")="Select Action: "
- S DIR("B")="SEL"
- 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="SEL" D SELX^PXLEXS(.LIST)
- I OPTION="REM" D REMX^PXLEXS(.LIST)
- ;
- S VALMBCK="R"
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXLEXS 11993 printed Jan 18, 2025@03:30:36 Page 2
- 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
- +2 ;
- +3 ;=========================================
- ADDSEL(ENUM) ;Add entry ENUM to the selected list and highlight it.
- +1 NEW CODE
- +2 SET CODE=^TMP("PXLEXL",$JOB,"CODE",ENUM)
- +3 SET ^TMP("PXLEXL",$JOB,"SELECTED",ENUM)=CODE
- +4 DO HLITE(ENUM,1)
- +5 QUIT
- +6 ;
- +7 ;=========================================
- BLDLIST ;Build the Lexicon list.
- +1 NEW ACTIVE,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 ;List Manager selection.
- +5 ;Clear the display.
- +6 DO KILL^VALM10
- +7 KILL ^TMP("PXLEXL",$JOB)
- +8 SET CODESYS=^TMP("PXLEXT",$JOB,"CODING SYSTEM")
- +9 SET TERM=^TMP("PXLEXT",$JOB,"SEARCH TERM")
- +10 SET EVENTDT=^TMP("PXLEXT",$JOB,"EVENT D/T")
- +11 SET ACTIVE=^TMP("PXLEXT",$JOB,"ACTIVE")
- +12 ;Clear the display.
- +13 DO KILL^VALM10
- +14 KILL ^TMP("PXLEXL",$JOB)
- +15 DO LEXLIST(TERM,CODESYS,EVENTDT,.NCODES,.NLINES,.TEXT,ACTIVE)
- +16 ;Get the coding system Lexicon information for building the display.
- +17 ;ICR #5679
- +18 SET CODESYSP=$$CSYS^LEXU(CODESYS)
- +19 SET TEXT=^TMP("PXLEXT",$JOB,"SEARCH TERM")
- +20 SET TEXT=$SELECT(($LENGTH(TEXT)'>66):TEXT,1:$EXTRACT(TEXT,1,63)_"...")
- +21 SET VALMHDR(1)="Term/Code: "_TEXT
- +22 SET VALMHDR(2)=NCODES_" "_$PIECE(CODESYSP,U,4)_$SELECT(NCODES=1:" code was found",1:" codes were found")
- +23 ;Set these so LM shows Page 1 of 1 when there are no codes.
- +24 IF NCODES=0
- SET VALMHDR(2)=VALMHDR(2)_"."
- SET ^TMP("PXLEXL",$JOB,1,0)=""
- SET VALMCNT=1
- QUIT
- +25 ;
- +26 SET VALMCNT=0
- +27 FOR IND=1:1:NLINES
- Begin DoDot:1
- +28 SET NUM=$PIECE(TEXT(IND),U,1)
- SET CODE=$PIECE(TEXT(IND),U,2)
- +29 IF NUM'=""
- IF CODE'=""
- SET ENUM=NUM
- SET ^TMP("PXLEXL",$JOB,"CODE",NUM)=CODE
- SET START=VALMCNT+1
- +30 DO FORMAT(TEXT(IND),FMTSTR,.NL,.OUTPUT)
- +31 FOR JND=1:1:NL
- Begin DoDot:2
- +32 SET VALMCNT=VALMCNT+1
- SET ^TMP("PXLEXL",$JOB,VALMCNT,0)=OUTPUT(JND)
- +33 SET ^TMP("PXLEXL",$JOB,"IDX",VALMCNT,ENUM)=""
- End DoDot:2
- +34 SET ^TMP("PXLEXL",$JOB,"LINES",ENUM)=START_U_VALMCNT
- End DoDot:1
- +35 SET ^TMP("PXLEXL",$JOB,"NCODES")=NCODES
- +36 SET ^TMP("PXLEXL",$JOB,"VALMCNT")=VALMCNT
- +37 QUIT
- +38 ;
- +39 ;=========================================
- ENTRY ;Entry code
- +1 DO INITMPG^PXLEXS
- +2 DO BLDLIST^PXLEXS
- +3 DO XQORM
- +4 QUIT
- +5 ;
- +6 ;=========================================
- EXIT ;Exit code
- +1 MERGE ^TMP("PXLEXT",$JOB,"SELECTED CODES")=^TMP("PXLEXL",$JOB,"SELECTED")
- +2 DO INITMPG^PXLEXS
- +3 DO FULL^VALM1
- +4 DO CLEAN^VALM10
- +5 DO KILL^VALM10
- +6 DO CLEAR^VALM1
- +7 SET VALMBCK="Q"
- +8 QUIT
- +9 ;
- +10 ;=========================================
- 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 ;=========================================
- 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.
- +2 NEW CODE,SELECTED
- +3 KILL ^TMP("PXLEXT",$JOB)
- +4 SET ^TMP("PXLEXT",$JOB,"CODING SYSTEM")=CODESYS
- +5 SET ^TMP("PXLEXT",$JOB,"SEARCH TERM")=SRCHTERM
- +6 SET ^TMP("PXLEXT",$JOB,"EVENT D/T")=EVENTDT
- +7 SET ^TMP("PXLEXT",$JOB,"SINGLE")=1
- +8 ;ACTIVE=1, return only active codes; ACTIVE=0, active and inactive.
- +9 SET ^TMP("PXLEXT",$JOB,"ACTIVE")=ACTIVE
- +10 DO EN^VALM("PXCE STANDARD CODES SELECT")
- +11 SET SELECTED=$ORDER(^TMP("PXLEXT",$JOB,"SELECTED CODES",""))
- +12 SET CODE=$SELECT(SELECTED="":"",1:^TMP("PXLEXT",$JOB,"SELECTED CODES",SELECTED))
- +13 KILL ^TMP("PXLEXT",$JOB)
- +14 QUIT CODE
- +15 ;
- +16 ;=========================================
- 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
- +2 ;selection.
- +3 KILL ^TMP("PXLEXT",$JOB)
- +4 SET ^TMP("PXLEXT",$JOB,"CODING SYSTEM")=CODESYS
- +5 SET ^TMP("PXLEXT",$JOB,"SEARCH TERM")=SRCHTERM
- +6 SET ^TMP("PXLEXT",$JOB,"EVENT D/T")=EVENTDT
- +7 SET ^TMP("PXLEXT",$JOB,"ACTIVE")=ACTIVE
- +8 DO EN^VALM("PXCE STANDARD CODES SELECT")
- +9 MERGE CODELIST=^TMP("PXLEXT",$JOB,"SELECTED CODES")
- +10 KILL ^TMP("PXLEXT",$JOB)
- +11 QUIT
- +12 ;
- +13 ;=========================================
- GETLIST(LIST) ;Let the user input a list of items.
- +1 NEW DIR,DIR0,INUM,ITEM,LEND,LELEM,NCODES,LSTART,X,Y
- +2 SET NCODES=+$GET(^TMP("PXLEXL",$JOB,"NCODES"))
- +3 IF NCODES=0
- QUIT
- +4 IF NCODES=1
- SET LIST(1)=""
- QUIT
- +5 SET DIR0=$SELECT($DATA(^TMP("PXLEXT",$JOB,"SINGLE")):"N^1:"_NCODES_":0",1:"LC^1:"_NCODES)
- +6 SET DIR(0)=DIR0
- +7 DO ^DIR
- +8 IF $EXTRACT(Y,1)="^"
- QUIT
- +9 IF Y?1.N
- SET LIST(Y)=""
- QUIT
- +10 ;Populate the list.
- +11 FOR INUM=1:1:($LENGTH(Y,",")-1)
- Begin DoDot:1
- +12 SET LELEM=$PIECE(Y,",",INUM)
- +13 IF LELEM?1.N
- SET LIST(LELEM)=""
- +14 SET LSTART=$PIECE(LELEM,"-",1)
- SET LEND=$PIECE(LELEM,"-",2)
- +15 FOR ITEM=LSTART:1:LEND
- SET LIST(ITEM)=""
- End DoDot:1
- +16 QUIT
- +17 ;
- +18 ;=========================================
- HDR ; Header code
- +1 SET VALMHDR(1)="Select the standard code(s)."
- +2 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- +3 QUIT
- +4 ;
- +5 ;=========================================
- HELP ;Display help.
- +1 NEW DDS,DIR0,DONE,IND,HTEXT,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 HTEXT=$SELECT($DATA(^TMP("PXLEXT",$JOB,"SINGLE")):"HTEXTS",1:"HTEXT")
- +5 SET DDS=1
- SET DONE=0
- +6 FOR IND=1:1
- if DONE
- QUIT
- Begin DoDot:1
- +7 SET TEXT(IND)=$PIECE($TEXT(@HTEXT+IND),";",3,99)
- +8 IF TEXT(IND)="**End Text**"
- KILL TEXT(IND)
- SET DONE=1
- QUIT
- End DoDot:1
- +9 DO BROWSE^DDBR("TEXT","NR","Lexicon Selection Help")
- +10 SET VALMBCK="R"
- +11 QUIT
- +12 ;
- +13 ;=========================================
- HLITE(ENUM,MODE) ;Highlight/un-highlight 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("PXLEXL",$JOB,"LINES",ENUM),U,1)
- +5 SET STOP=$PIECE(^TMP("PXLEXL",$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=0
- DO FLDCTRL^VALM10(START,"CODE",IORVOFF,IORVOFF,"")
- +9 QUIT
- +10 ;
- +11 ;=========================================
- HTEXT ;Lexicon selection help text.
- +1 ;;Select one of the following actions:
- +2 ;;
- +3 ;; SEL - Select codes to add to the encounter.
- +4 ;; REM - Removes selected codes from the encounter.
- +5 ;;
- +6 ;;When you exit by typing 'Q' the selected codes will be added to or removed
- +7 ;;from the encounter depending on the chosen action.
- +8 ;;
- +9 ;;You can select the action first and then be prompted for a list of codes or
- +10 ;;you can input the list and then select the action. Because of the way List
- +11 ;;Manager works, you may be able to select a larger list by selecting the action
- +12 ;;first.
- +13 ;;
- +14 ;;**End Text**
- +15 QUIT
- +16 ;=========================================
- HTEXTS ;Lexicon single selection help text.
- +1 ;;Select one of the following actions:
- +2 ;;
- +3 ;; SEL - Select a code to add to the encounter.
- +4 ;; REM - Remove a code from the encounter.
- +5 ;;
- +6 ;;When you exit by typing 'Q' the selected code will be added to or removed
- +7 ;;from the encounter depending on the chosen action.
- +8 ;;
- +9 ;;You can select the action first and then be prompted for a code or you
- +10 ;;can select a code and then select the action.
- +11 ;;
- +12 ;;**End Text**
- +13 QUIT
- +14 ;
- +15 ;=========================================
- INITMPG ;Initialize all the ^TMP globals.
- +1 KILL ^TMP("PXLEXL",$JOB)
- +2 QUIT
- +3 ;
- +4 ;=========================================
- LEXLIST(TERM,CODESYS,EVENTDT,NCODES,NLINES,TEXT,ACTIVE) ;Call Lexicon to get
- +1 ;the list of codes.
- +2 NEW ACTDT,CODE,CODEI,INACTDT,IND,NUM
- +3 NEW RESULT,SRC,SDESC,TEMP
- +4 WRITE @IOF,"Searching Lexicon ..."
- +5 KILL ^TMP("PXLEX",$JOB)
- +6 ;DBIA #5681
- +7 SET RESULT=$$TAX^LEX10CS(TERM,CODESYS,EVENTDT,"PXLEX",ACTIVE)
- +8 SET NCODES=+RESULT
- +9 IF NCODES=-1
- SET (NCODES,NLINES)=0
- KILL ^TMP("PXLEX",$JOB)
- QUIT
- +10 IF CODESYS="SCT"
- DO SCTDESC("PXLEX")
- +11 SET SRC=0
- +12 SET (NLINES,NUM)=0
- +13 FOR
- SET SRC=$ORDER(^TMP("PXLEX",$JOB,SRC))
- if SRC=""
- QUIT
- Begin DoDot:1
- +14 SET CODEI=""
- +15 FOR
- SET CODEI=$ORDER(^TMP("PXLEX",$JOB,SRC,CODEI))
- if CODEI=""
- QUIT
- Begin DoDot:2
- +16 SET NUM=NUM+1
- SET IND=0
- +17 FOR
- SET IND=$ORDER(^TMP("PXLEX",$JOB,SRC,CODEI,IND))
- if IND=""
- QUIT
- Begin DoDot:3
- +18 SET TEMP=^TMP("PXLEX",$JOB,SRC,CODEI,IND)
- +19 SET ACTDT=$PIECE(TEMP,U,1)
- SET INACTDT=$PIECE(TEMP,U,2)
- +20 SET TEMP=^TMP("PXLEX",$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:3
- End DoDot:2
- End DoDot:1
- +25 KILL ^TMP("PXLEX",$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 ;=========================================
- REM(ENUM) ;Remove entry ENUM from the selected list and un-highlight it.
- +1 KILL ^TMP("PXLEXL",$JOB,"SELECTED",ENUM)
- +2 DO HLITE(ENUM,0)
- +3 QUIT
- +4 ;
- +5 ;=========================================
- REML ;Remove the selected entries from the selected list and un-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 REM(SEL)
- +8 SET VALMBCK="R"
- +9 QUIT
- +10 ;
- +11 ;=========================================
- REMX(LIST) ;Remove the selected entries from the selected list and un-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 REM(ENUM)
- End DoDot:1
- +6 QUIT
- +7 ;
- +8 ;=========================================
- SCTDESC(NODE) ;Append the SNOMED hierarchy to the description and then
- +1 ;sort the list by description.
- +2 NEW ACTDT,CODEI,CODE,DESC,FSN,HE,HIER,HS,NUM,SRC
- +3 KILL ^TMP($JOB,"DESC"),^TMP($JOB,"SORT")
- +4 SET SRC=$ORDER(^TMP(NODE,$JOB,0))
- +5 SET CODEI=""
- +6 FOR
- SET CODEI=$ORDER(^TMP(NODE,$JOB,SRC,CODEI))
- if CODEI=""
- QUIT
- Begin DoDot:1
- +7 SET ACTDT=$PIECE(^TMP(NODE,$JOB,SRC,CODEI,1),U,1)
- +8 SET CODE=$PIECE(^TMP(NODE,$JOB,SRC,CODEI,1,0),U,1)
- +9 SET DESC=$PIECE(^TMP(NODE,$JOB,SRC,CODEI,1,0),U,2)
- +10 ;DBIA #5007
- +11 SET FSN=$$GETFSN^LEXTRAN1(SRC,CODE,ACTDT)
- +12 SET HS=$FIND(FSN,"(")
- +13 SET HE=$FIND(FSN,")",HS)
- +14 SET HIER=$EXTRACT(FSN,HS-1,HE-1)
- +15 SET DESC=DESC_" "_HIER
- +16 SET ^TMP($JOB,"DESC",DESC,CODEI)=""
- End DoDot:1
- +17 SET DESC=""
- SET NUM=0
- +18 FOR
- SET DESC=$ORDER(^TMP($JOB,"DESC",DESC))
- if DESC=""
- QUIT
- Begin DoDot:1
- +19 SET CODEI=""
- +20 FOR
- SET CODEI=$ORDER(^TMP($JOB,"DESC",DESC,CODEI))
- if CODEI=""
- QUIT
- Begin DoDot:2
- +21 SET NUM=NUM+1
- +22 MERGE ^TMP($JOB,"SORT",SRC,NUM)=^TMP(NODE,$JOB,SRC,CODEI)
- +23 SET $PIECE(^TMP($JOB,"SORT",SRC,NUM,1,0),U,2)=DESC
- End DoDot:2
- End DoDot:1
- +24 KILL ^TMP(NODE,$JOB)
- +25 MERGE ^TMP(NODE,$JOB)=^TMP($JOB,"SORT")
- +26 KILL ^TMP($JOB,"DESC"),^TMP($JOB,"SORT")
- +27 QUIT
- +28 ;
- +29 ;=========================================
- SELL ;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 ;=========================================
- SELX(LIST) ;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)
- End DoDot:1
- +6 QUIT
- +7 ;
- +8 ;=========================================
- XQORM ; Set range for selection.
- +1 NEW NCODES
- +2 SET NCODES=+$GET(^TMP("PXLEXL",$JOB,"NCODES"))
- +3 IF NCODES=0
- QUIT
- +4 SET XQORM("#")=$ORDER(^ORD(101,"B","PXCE LEXICON SELECT ENTRY",0))_U_"1:"_NCODES
- +5 SET XQORM("A")="Select Action: "
- +6 QUIT
- +7 ;
- +8 ;=========================================
- XSEL ;Entry action for protocol PXCE LEXICON SELECT ENTRY.
- +1 NEW ENUM,IND,LIST,LVALID
- +2 SET LIST=$PIECE(XQORNOD(0),"=",2)
- +3 ;Remove trailing ,
- +4 IF $EXTRACT(LIST,$LENGTH(LIST))=","
- SET LIST=$EXTRACT(LIST,1,$LENGTH(LIST)-1)
- +5 SET LVALID=1
- +6 FOR IND=1:1:$LENGTH(LIST,",")
- Begin DoDot:1
- +7 SET ENUM=$PIECE(LIST,",",IND)
- +8 IF (ENUM<1)!(ENUM>VALMCNT)!('$DATA(^TMP("PXLEXL",$JOB,"LINES",ENUM)))
- Begin DoDot:2
- +9 WRITE !,ENUM," is not a valid selection."
- +10 WRITE !,"The range is 1 to ",$ORDER(^TMP("PXLEXL",$JOB,"LINES",""),-1),"."
- +11 HANG 2
- +12 SET LVALID=0
- End DoDot:2
- End DoDot:1
- +13 IF $DATA(^TMP("PXLEXT",$JOB,"SINGLE"))
- IF LIST'?1.N
- Begin DoDot:1
- +14 WRITE !,"Only a single code can be selected."
- +15 SET LVALID=0
- +16 HANG 2
- End DoDot:1
- +17 IF 'LVALID
- SET VALMBCK="R"
- QUIT
- +18 ;
- +19 ;Full screen mode
- +20 DO FULL^VALM1
- +21 ;
- +22 ;Possible actions.
- +23 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
- +24 SET DIR(0)="SBM"_U_"SEL:Select code(s);"
- +25 SET DIR(0)=DIR(0)_"REM:Remove code(s);"
- +26 SET DIR("A")="Select Action: "
- +27 SET DIR("B")="SEL"
- +28 SET DIR("?")="Select from the actions displayed."
- +29 DO ^DIR
- +30 IF $DATA(DIROUT)!$DATA(DIRUT)
- SET VALMBCK="R"
- QUIT
- +31 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET VALMBCK="R"
- QUIT
- +32 SET OPTION=Y
- +33 DO CLEAR^VALM1
- +34 ;
- +35 IF OPTION="SEL"
- DO SELX^PXLEXS(.LIST)
- +36 IF OPTION="REM"
- DO REMX^PXLEXS(.LIST)
- +37 ;
- +38 SET VALMBCK="R"
- +39 QUIT
- +40 ;