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

PXRMTXLS.m

Go to the documentation of this file.
  1. PXRMTXLS ;SLC/PKR - List Manager routines for taxonomy all selected codes. ;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 CODESYS,NDUP,UIDT
  1. S CODESYS=$P(^TMP("PXRMTXSC",$J,"CODE",ENUM,1),U,2)
  1. S UIDT=$S('UID:0,1:$$UIDOK^PXRMUID(CODESYS))
  1. D HLITE(ENUM,1,UIDT)
  1. S NDUP=0
  1. F S NDUP=$O(^TMP("PXRMTXSC",$J,"CODE",ENUM,NDUP)) Q:NDUP="" D
  1. . S ^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP)=^TMP("PXRMTXSC",$J,"CODE",ENUM,NDUP)
  1. . S $P(^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP),U,4)=UIDT
  1. Q
  1. ;
  1. ;=========================================
  1. BLDLIST ;Build the list of all selected codes.
  1. N CODE,CODESYS,CODESYSP,ENUM,FMTSTR,IND,JND,NDUP,NL,NLINES
  1. N NSEL,NUID,NUM,OUTPUT,START,TERM,TEXT,UID,UIDOK,UIDMSG
  1. S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLLL")
  1. ;^TMP("PXRMTAX",$J) is set in VEALLSEL^PXRMTXSM which invokes the List
  1. ;Manager screen PXRM TAXONOMY ALL SELECTED MENU. It is also set in
  1. ;UIDE^PXRMTAXL which starts the UID edit.
  1. ;Clear the display.
  1. D KILL^VALM10
  1. K ^TMP("PXRMTXSC",$J)
  1. I '$D(^TMP("PXRMCODES",$J)) D Q
  1. . S VALMHDR(2)="No codes have been selected.",^TMP("PXRMTXSC",$J,1,0)=""
  1. . S VALMCNT=1,VALMBCK="R"
  1. ;Build the display list grouped by coding system.
  1. S TERM=""
  1. F S TERM=$O(^TMP("PXRMCODES",$J,TERM)) Q:TERM="" D
  1. . S CODESYS=""
  1. . F S CODESYS=$O(^TMP("PXRMCODES",$J,TERM,CODESYS)) Q:CODESYS="" D
  1. .. S CODE=""
  1. .. F S CODE=$O(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q:CODE="" D
  1. ... S ^TMP("PXRMTXSC",$J,"CODES",CODESYS,CODE)=^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
  1. ... S ^TMP("PXRMTXSC",$J,"CODES",CODESYS,CODE,TERM)=^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
  1. ;
  1. S (ENUM,NLINES,NUID,VALMCNT)=0
  1. S CODESYS=""
  1. F S CODESYS=$O(^TMP("PXRMTXSC",$J,"CODES",CODESYS)) Q:CODESYS="" D
  1. .;Get the Lexicon coding system information for building the display.
  1. .;DBIA #5679
  1. . S CODESYSP=$$CSYS^LEXU(CODESYS)
  1. . S UIDOK=$$UIDOK^PXRMUID(CODESYS)
  1. . S UIDMSG=" (This coding system "_$S(UIDOK:"can",1:"cannot")_" be used in a dialog.)"
  1. . S VALMCNT=VALMCNT+1,^TMP("PXRMTXSC",$J,VALMCNT,0)=""
  1. . S VALMCNT=VALMCNT+1,^TMP("PXRMTXSC",$J,VALMCNT,0)=$P(CODESYSP,U,4)_UIDMSG
  1. . S CODE=""
  1. . F S CODE=$O(^TMP("PXRMTXSC",$J,"CODES",CODESYS,CODE)) Q:CODE="" D
  1. .. S ENUM=ENUM+1,START=VALMCNT+1
  1. .. D LEXPER(ENUM,CODE,CODESYS,.NLINES,.TEXT)
  1. .. F IND=1:1:NLINES D
  1. ... D FORMAT(TEXT(IND),FMTSTR,.NL,.OUTPUT)
  1. ... F JND=1:1:NL S VALMCNT=VALMCNT+1,^TMP("PXRMTXSC",$J,VALMCNT,0)=OUTPUT(JND)
  1. .. S ^TMP("PXRMTXSC",$J,"IDX",START,ENUM)=""
  1. .. S ^TMP("PXRMTXSC",$J,"LINES",ENUM)=START_U_VALMCNT
  1. .. S UID=+^TMP("PXRMTXSC",$J,"CODES",CODESYS,CODE)
  1. .. I UID S NUID=NUID+1
  1. .. D HLITE(ENUM,1,UID)
  1. .. S TERM="",NDUP=0
  1. .. F S TERM=$O(^TMP("PXRMTXSC",$J,"CODES",CODESYS,CODE,TERM)) Q:TERM="" D
  1. ... S NDUP=NDUP+1
  1. ... S TEMP=TERM_U_CODESYS_U_CODE_U_UID
  1. ... S ^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP)=TEMP
  1. ... S ^TMP("PXRMTXSC",$J,"CODE",ENUM,NDUP)=TEMP
  1. S ^TMP("PXRMTXSC",$J,"NCODES")=ENUM
  1. S ^TMP("PXRMTXSC",$J,"VALMCNT")=VALMCNT
  1. ;Set these so LM shows Page 1 of 1 when there are no codes.
  1. I ENUM=0 S VALMHDR(2)="No codes have been selected.",^TMP("PXRMTXSC",$J,1,0)="",VALMCNT=1 Q
  1. S VALMHDR(2)=ENUM_" codes have been selected, "_NUID_" are marked UID."
  1. Q
  1. ;
  1. ;=========================================
  1. ENTRY ;Entry code
  1. D INITMPG^PXRMTXLS
  1. D HDR^PXRMTXLS
  1. D BLDLIST^PXRMTXLS
  1. D XQORM^PXRMTXLS
  1. Q
  1. ;
  1. ;=========================================
  1. EXIT ;Exit code
  1. D INITMPG^PXRMTXLS
  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^PXRMTXLS
  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 INUM,ITEM,LEND,LELEM,NCODES,LSTART,X,Y
  1. S NCODES=+$G(^TMP("PXRMTXSC",$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)="All selected codes in this 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("PXRMTXSC",$J,"LINES",ENUM),U,1)
  1. S STOP=$P(^TMP("PXRMTXSC",$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. PROBABLY CAN REMOVE AND USE ORIGINAL
  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. 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 CODESYS,ENUM,IND,NDUP
  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("PXRMTXSC",$J)
  1. Q
  1. ;
  1. ;=========================================
  1. LEXPER(ENUM,CODE,CODESYS,NLINES,TEXT) ;Call PERIOD^LEXU to get the code
  1. ;information.
  1. N ACTDT,DESC,INACTDT,PDATA,RESULT
  1. ;DBIA #5679
  1. S RESULT=$$PERIOD^LEXU(CODE,CODESYS,.PDATA)
  1. I +RESULT=-1 S NLINES=0 Q
  1. S (ACTDT,NLINES)=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 NLINES=NLINES+1
  1. . I NLINES=1 S TEXT(NLINES)=ENUM_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. PEXIT ; Protocol exit code
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. ;Reset after page up/down etc
  1. D XQORM^PXRMTXLS
  1. Q
  1. ;
  1. ;=========================================
  1. RFD(ENUM) ;Remove UID from the selected entry.
  1. N NDUP,START
  1. S NDUP=0
  1. F S NDUP=$O(^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP)) Q:NDUP="" D
  1. . S $P(^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP),U,4)=0
  1. S START=$P(^TMP("PXRMTXSC",$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. N CODE,CODESYS,DEL,NDUP,TEMP,TERM
  1. S NDUP=0
  1. F S NDUP=$O(^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP)) Q:NDUP="" D
  1. . S TEMP=^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP)
  1. . S ^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP)=TEMP_U_"@"
  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. This amounts to rebuilding
  1. ;^TMP("PXRMCODES",$J).
  1. N CODE,CODESYS,DEL,ENUM,NDUP,TEMP,TERM,UID
  1. S ENUM=0
  1. F S ENUM=$O(^TMP("PXRMTXSC",$J,"SELECTED",ENUM)) Q:ENUM="" D
  1. . S NDUP=0
  1. . F S NDUP=$O(^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP)) Q:NDUP="" D
  1. .. S TEMP=^TMP("PXRMTXSC",$J,"SELECTED",ENUM,NDUP)
  1. .. S TERM=$P(TEMP,U,1),CODESYS=$P(TEMP,U,2)
  1. .. S CODE=$P(TEMP,U,3),UID=$P(TEMP,U,4)
  1. .. I TEMP["@" K ^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
  1. .. E S ^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)=UID
  1. ;Check for terms that should be deleted.
  1. S TERM=""
  1. F S TERM=$O(^TMP("PXRMCODES",$J,TERM)) Q:TERM="" D
  1. . S DEL=$$TERMDEL(TERM)
  1. . I DEL S ^TMP("PXRMCODES",$J,TERM)="@" Q
  1. . S CODESYS=""
  1. . F S CODESYS=$O(^TMP("PXRMCODES",$J,TERM,CODESYS)) Q:CODESYS="" D
  1. ..;(TERM,CODESYS) exists but has no codes if $D=1
  1. .. I $D(^TMP("PXRMCODES",$J,TERM,CODESYS))=1 S ^TMP("PXRMCODES",$J,TERM,CODESYS)=""
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. TERMDEL(TERM) ;Determine how many codes this term contains. If there are none
  1. ;then ask the user if they want the term deleted.
  1. N CODE,CODESYS,DEL,DIR,IENS,IND,KFDA,MSG,NCODES,TEXT,X,Y
  1. S CODESYS="",NCODES=0
  1. S CODESYS=""
  1. F S CODESYS=$O(^TMP("PXRMCODES",$J,TERM,CODESYS)) Q:CODESYS="" D
  1. . S CODE=""
  1. . F S CODE=$O(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q:CODE="" S NCODES=NCODES+1
  1. ;
  1. I NCODES>0 Q 0
  1. ;Have the user verify the term deletion is OK.
  1. S TEXT(1)=""
  1. S TEXT(2)="All the codes in term "_TERM
  1. S TEXT(3)="have been selected for removal from the taxonomy."
  1. S TEXT(4)=""
  1. D EN^DDIOL(.TEXT)
  1. S DIR(0)="YAO"
  1. S DIR("A")="Do you want this term deleted too? "
  1. S DIR("B")="Y"
  1. D ^DIR
  1. ;The user said not to delete the term.
  1. I +Y=0 Q 0
  1. K TEXT
  1. S TEXT(1)="The term will be deleted when the editing session is saved."
  1. S TEXT(2)=""
  1. D EN^DDIOL(.TEXT) H 2
  1. Q 1
  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. XQORM ; Set range for selection.
  1. N NCODES
  1. S NCODES=+$G(^TMP("PXRMTXSC",$J,"NCODES"))
  1. I NCODES=0 Q
  1. S XQORM("#")=$O(^ORD(101,"B","PXRM TAXONOMY ALL SELECTED SELECT",0))_U_"1:"_NCODES
  1. S XQORM("A")="Select Action: "
  1. Q
  1. ;
  1. ;=========================================
  1. XSEL ;Entry action for protocol PXRM TAXONOMY ALL SELECTED SELECT.
  1. N ENUM,IND,LIST,NCODES,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. S NCODES=+$O(^TMP("PXRMTXSC",$J,"LINES",""),-1)
  1. F IND=1:1:$L(LIST,",") D
  1. . S ENUM=$P(LIST,",",IND)
  1. . I (ENUM<1)!(ENUM>NCODES) D
  1. .. W !,ENUM," is not a valid selection."
  1. .. W !,"The range is 1 to ",NCODES,"."
  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. 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^PXRMTXLS(.LIST,0)
  1. I OPTION="RFD" D RFDX^PXRMTXLS(.LIST)
  1. I OPTION="RFT" D RFTX^PXRMTXLS(.LIST)
  1. I OPTION="UID" D INCX^PXRMTXLS(.LIST,1)
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;