PXRMTXCE ;SLC/PKR - List Manager routines for taxonomy choose entries. ;05/21/2013
;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
;
;=========================================
ENTRY ;Entry code
K ^TMP("PXRMTAXCE",$J)
I '$D(^TMP("PXRMTAXL",$J)) D BLDLIST^PXRMTAXL("PXRMTAXL")
M ^TMP("PXRMTAXCE",$J)=^TMP("PXRMTAXL",$J)
D XQORM
Q
;
;=========================================
EXIT ;Exit code
K ^TMP("PXRMTAXCE",$J)
S VALMBCK="R"
Q
;
;=========================================
HDR ; Header code
S VALMHDR(1)="Taxonomy File Entries."
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
;=========================================
HELP ;Display help.
N DDS,DIR0,DONE,IND,TEXT
;DBIA #5746 covers kill and set of DDS. DDS needs to be set or the
;Browser will kill some ScreenMan variables.
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","Taxonomy Choose Entries Help")
S VALMBCK="R"
Q
;
;=========================================
HLITE(ENUM,MODE,PXRMTIEN) ;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("PXRMTAXCE",$J,"LINES",ENUM),U,1)
S STOP=$P(^TMP("PXRMTAXCE",$J,"LINES",ENUM),U,2)
F LINE=START:1:STOP D CNTRL^VALM10(LINE,1,80,VCTRL,IOINORM)
S VALMHDR(1)=$$SLIST(.PXRMTIEN)
Q
;
;=========================================
HTEXT ;Taxonomy choose entries help text.
;;Select one of the following actions:
;; SEL - select a taxonomy to add to the list.
;; REM - remove a taxonomy from the list.
;; INQ - taxonomy inquiry.
;; DONE - done building the selection list.
;;**End Text**
Q
;
;=========================================
PEXIT ; Protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
;Reset after page up/down etc
D XQORM
Q
;
;=========================================
REMTAX ;Remove a taxonomy.
N IEN
;Get the entry
S IEN=+$$GETSEL^PXRMTAXL("Remove which taxonomy from selection list?")
I IEN=0 S VALMBCK="R" Q
D REMOVE(IEN)
Q
;
;=========================================
REMOVE(IEN) ;
N ENUM
K PXRMTIEN(IEN)
S ENUM=+$G(^TMP("PXRMTAXCE",$J,"IEN",IEN))
I ENUM>0 D HLITE(ENUM,0,.PXRMTIEN)
S VALMBCK="R"
Q
;
;=========================================
SELECTED(IEN) ;
N ENUM
S ENUM=+$G(^TMP("PXRMTAXCE",$J,"IEN",IEN))
S PXRMTIEN(IEN)=ENUM
I ENUM>0 D HLITE(ENUM,1,.PXRMTIEN)
S VALMBCK="R"
Q
;
;=========================================
SELTAX ;Select a taxonomy.
N IEN
;Get the entry
S IEN=+$$GETSEL^PXRMTAXL("Add which taxonomy to selection list?")
I IEN=0 S VALMBCK="R" Q
D SELECTED(IEN)
Q
;
;=========================================
SLIST(PXRMTIEN) ;
N IEN,ENUM,ENUMLIST,SLIST
S IEN=""
F S IEN=$O(PXRMTIEN(IEN)) Q:IEN="" S ENUMLIST(PXRMTIEN(IEN))=""
S ENUM=$O(ENUMLIST("")),SLIST=ENUM
F S ENUM=$O(ENUMLIST(ENUM)) Q:ENUM="" S SLIST=SLIST_", "_ENUM
I SLIST="" S SLIST="none"
Q "Selected taxonomies: "_SLIST_"."
;
;=========================================
START ;Main entry point for PXRM TAXONOMY SELECTION
W !,"Select a taxonomy or taxonomies to import from." H 2
D EN^VALM("PXRM TAXONOMY CHOOSE ENTRIES")
Q
;
;=========================================
XQORM ;Set range for selection.
N NTAX
S NTAX=^TMP("PXRMTAXCE",$J,"NTAX")
S XQORM("#")=$O(^ORD(101,"B","PXRM TAXONOMY CHOOSE ENTRY",0))_U_"1:"_NTAX
S XQORM("A")="Select Action: "
Q
;
;=========================================
XSEL ;Entry action for protocol PXRM TAXONOMY CHOOSE ENTRY.
N IEN,SEL
S SEL=$P(XQORNOD(0),"=",2)
;Remove trailing ,
I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
;Invalid selection
I SEL["," D Q
. W !,"Only one item number allowed." H 2
. S VALMBCK="R"
I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
. W !,SEL_" is not a valid item number." H 2
. S VALMBCK="R"
;
;Get the IEN.
S IEN=^TMP("PXRMTAXL",$J,"SEL",SEL)
;
;Full screen mode
D FULL^VALM1
;
;Action list.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
S DIR(0)="SBM"_U
S DIR(0)=DIR(0)_"SEL:Select;REM:Remove;INQ:Inquire"
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="INQ" D INQ^PXRMTAXL(IEN)
I OPTION="REM" D REMOVE^PXRMTXCE(IEN)
I OPTION="SEL" D SELECTED^PXRMTXCE(IEN)
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMTXCE 4676 printed Oct 16, 2024@17:50:20 Page 2
PXRMTXCE ;SLC/PKR - List Manager routines for taxonomy choose entries. ;05/21/2013
+1 ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
+2 ;
+3 ;=========================================
ENTRY ;Entry code
+1 KILL ^TMP("PXRMTAXCE",$JOB)
+2 IF '$DATA(^TMP("PXRMTAXL",$JOB))
DO BLDLIST^PXRMTAXL("PXRMTAXL")
+3 MERGE ^TMP("PXRMTAXCE",$JOB)=^TMP("PXRMTAXL",$JOB)
+4 DO XQORM
+5 QUIT
+6 ;
+7 ;=========================================
EXIT ;Exit code
+1 KILL ^TMP("PXRMTAXCE",$JOB)
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
+5 ;=========================================
HDR ; Header code
+1 SET VALMHDR(1)="Taxonomy File Entries."
+2 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+3 QUIT
+4 ;
+5 ;=========================================
HELP ;Display help.
+1 NEW DDS,DIR0,DONE,IND,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 DDS=1
SET DONE=0
+5 FOR IND=1:1
if DONE
QUIT
Begin DoDot:1
+6 SET TEXT(IND)=$PIECE($TEXT(HTEXT+IND),";",3,99)
+7 IF TEXT(IND)="**End Text**"
KILL TEXT(IND)
SET DONE=1
QUIT
End DoDot:1
+8 DO BROWSE^DDBR("TEXT","NR","Taxonomy Choose Entries Help")
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
+12 ;=========================================
HLITE(ENUM,MODE,PXRMTIEN) ;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("PXRMTAXCE",$JOB,"LINES",ENUM),U,1)
+5 SET STOP=$PIECE(^TMP("PXRMTAXCE",$JOB,"LINES",ENUM),U,2)
+6 FOR LINE=START:1:STOP
DO CNTRL^VALM10(LINE,1,80,VCTRL,IOINORM)
+7 SET VALMHDR(1)=$$SLIST(.PXRMTIEN)
+8 QUIT
+9 ;
+10 ;=========================================
HTEXT ;Taxonomy choose entries help text.
+1 ;;Select one of the following actions:
+2 ;; SEL - select a taxonomy to add to the list.
+3 ;; REM - remove a taxonomy from the list.
+4 ;; INQ - taxonomy inquiry.
+5 ;; DONE - done building the selection list.
+6 ;;**End Text**
+7 QUIT
+8 ;
+9 ;=========================================
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 ;=========================================
REMTAX ;Remove a taxonomy.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL^PXRMTAXL("Remove which taxonomy from selection list?")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO REMOVE(IEN)
+6 QUIT
+7 ;
+8 ;=========================================
REMOVE(IEN) ;
+1 NEW ENUM
+2 KILL PXRMTIEN(IEN)
+3 SET ENUM=+$GET(^TMP("PXRMTAXCE",$JOB,"IEN",IEN))
+4 IF ENUM>0
DO HLITE(ENUM,0,.PXRMTIEN)
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;=========================================
SELECTED(IEN) ;
+1 NEW ENUM
+2 SET ENUM=+$GET(^TMP("PXRMTAXCE",$JOB,"IEN",IEN))
+3 SET PXRMTIEN(IEN)=ENUM
+4 IF ENUM>0
DO HLITE(ENUM,1,.PXRMTIEN)
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;=========================================
SELTAX ;Select a taxonomy.
+1 NEW IEN
+2 ;Get the entry
+3 SET IEN=+$$GETSEL^PXRMTAXL("Add which taxonomy to selection list?")
+4 IF IEN=0
SET VALMBCK="R"
QUIT
+5 DO SELECTED(IEN)
+6 QUIT
+7 ;
+8 ;=========================================
SLIST(PXRMTIEN) ;
+1 NEW IEN,ENUM,ENUMLIST,SLIST
+2 SET IEN=""
+3 FOR
SET IEN=$ORDER(PXRMTIEN(IEN))
if IEN=""
QUIT
SET ENUMLIST(PXRMTIEN(IEN))=""
+4 SET ENUM=$ORDER(ENUMLIST(""))
SET SLIST=ENUM
+5 FOR
SET ENUM=$ORDER(ENUMLIST(ENUM))
if ENUM=""
QUIT
SET SLIST=SLIST_", "_ENUM
+6 IF SLIST=""
SET SLIST="none"
+7 QUIT "Selected taxonomies: "_SLIST_"."
+8 ;
+9 ;=========================================
START ;Main entry point for PXRM TAXONOMY SELECTION
+1 WRITE !,"Select a taxonomy or taxonomies to import from."
HANG 2
+2 DO EN^VALM("PXRM TAXONOMY CHOOSE ENTRIES")
+3 QUIT
+4 ;
+5 ;=========================================
XQORM ;Set range for selection.
+1 NEW NTAX
+2 SET NTAX=^TMP("PXRMTAXCE",$JOB,"NTAX")
+3 SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM TAXONOMY CHOOSE ENTRY",0))_U_"1:"_NTAX
+4 SET XQORM("A")="Select Action: "
+5 QUIT
+6 ;
+7 ;=========================================
XSEL ;Entry action for protocol PXRM TAXONOMY CHOOSE ENTRY.
+1 NEW IEN,SEL
+2 SET SEL=$PIECE(XQORNOD(0),"=",2)
+3 ;Remove trailing ,
+4 IF $EXTRACT(SEL,$LENGTH(SEL))=","
SET SEL=$EXTRACT(SEL,1,$LENGTH(SEL)-1)
+5 ;Invalid selection
+6 IF SEL[","
Begin DoDot:1
+7 WRITE !,"Only one item number allowed."
HANG 2
+8 SET VALMBCK="R"
End DoDot:1
QUIT
+9 IF ('SEL)!(SEL>VALMCNT)!('$DATA(@VALMAR@("SEL",SEL)))
Begin DoDot:1
+10 WRITE !,SEL_" is not a valid item number."
HANG 2
+11 SET VALMBCK="R"
End DoDot:1
QUIT
+12 ;
+13 ;Get the IEN.
+14 SET IEN=^TMP("PXRMTAXL",$JOB,"SEL",SEL)
+15 ;
+16 ;Full screen mode
+17 DO FULL^VALM1
+18 ;
+19 ;Action list.
+20 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
+21 SET DIR(0)="SBM"_U
+22 SET DIR(0)=DIR(0)_"SEL:Select;REM:Remove;INQ:Inquire"
+23 SET DIR("A")="Select Action: "
+24 SET DIR("B")="SEL"
+25 SET DIR("?")="Select from the actions displayed."
+26 DO ^DIR
+27 IF $DATA(DIROUT)!$DATA(DIRUT)
SET VALMBCK="R"
QUIT
+28 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMBCK="R"
QUIT
+29 SET OPTION=Y
+30 DO CLEAR^VALM1
+31 ;
+32 IF OPTION="INQ"
DO INQ^PXRMTAXL(IEN)
+33 IF OPTION="REM"
DO REMOVE^PXRMTXCE(IEN)
+34 IF OPTION="SEL"
DO SELECTED^PXRMTXCE(IEN)
+35 SET VALMBCK="R"
+36 QUIT
+37 ;
