PXRMUIDE ;SLC/PKR - List Manager routines for taxonomy UID edit. ;05/22/2017
;;2.0;CLINICAL REMINDERS;**26,47,42**;Feb 04, 2005;Build 245
;
;=========================================
ENTRY ;Entry code
N TAXIEN
S TAXIEN=^TMP("PXRMTAX",$J,"TAXIEN")
D INITMPG^PXRMTXLS
K ^TMP("PXRMCODES",$J)
D HDR^PXRMUIDE
D CODELIST^PXRMTXSM(TAXIEN)
D BLDLIST^PXRMTXLS
D XQORM^PXRMUIDE
Q
;
;=========================================
EXIT ;Exit code
D INITMPG^PXRMTXLS
K ^TMP("PXRMCODES",$J)
D FULL^VALM1
D CLEAN^VALM10
D KILL^VALM10
D CLEAR^VALM1
S VALMBCK="Q"
Q
;
;=========================================
EXITS ;Exit and save action.
D SAVE^PXRMUIDE
D EXIT^PXRMUIDE
Q
;
;=========================================
HDR ; Header code
S VALMHDR(1)="Edit UID for all selected codes in this taxonomy."
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","UID Edit Help")
S VALMBCK="R"
Q
;
;=========================================
HTEXT ;Lexicon selection help text. PROBABLY CAN REMOVE AND USE ORIGINAL
;;Select one of the following actions:
;;
;; RFD - removes selected codes from being used in a dialog.
;; UID - adds selected codes to the taxonomy and marks them for use in a dialog.
;; SAVE - saves all selected codes. Even if codes have been selected, they will
;; not be stored until they are saved. Finally, a save must be done when
;; exiting the ScreenMan form or no changes will be saved.
;; EXIT - saves then exits.
;;
;;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
;
;=========================================
PEXIT ; Protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
;Reset after page up/down etc
D XQORM^PXRMUIDE
Q
;
;=========================================
SAVE ;Save the changes.
N TAXIEN
S TAXIEN=^TMP("PXRMTAX",$J,"TAXIEN")
D SAVE^PXRMTXLS
D POSTSAVE^PXRMTXSM(TAXIEN)
S VALMBCK="R"
Q
;
;=========================================
XQORM ; Set range for selection.
N NCODES
S NCODES=+$G(^TMP("PXRMTXSC",$J,"NCODES"))
I NCODES=0 Q
S XQORM("#")=$O(^ORD(101,"B","PXRM TAXONOMY UIDE SELECT ENTRY",0))_U_"1:"_NCODES
S XQORM("A")="Select Action: "
Q
;
;=========================================
XSEL ;Entry action for protocol PXRM TAXONOMY ALL SELECTED SELECT.
N ENUM,IND,LIST,NCODES,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
S NCODES=+$O(^TMP("PXRMTXSC",$J,"LINES",""),-1)
F IND=1:1:$L(LIST,",") D
. S ENUM=$P(LIST,",",IND)
. I (ENUM<1)!(ENUM>NCODES) D
.. W !,ENUM," is not a valid selection."
.. W !,"The range is 1 to ",NCODES,"."
.. H 2
.. S LVALID=0
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_"RFD:Remove from dialog;"
S DIR(0)=DIR(0)_"UID:Use in dialog;"
S DIR("A")="Select Action: "
S DIR("B")="UID"
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="RFD" D RFDX^PXRMTXLS(.LIST)
I OPTION="UID" D INCX^PXRMTXLS(.LIST,1)
;
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMUIDE 3919 printed Oct 16, 2024@17:50:32 Page 2
PXRMUIDE ;SLC/PKR - List Manager routines for taxonomy UID edit. ;05/22/2017
+1 ;;2.0;CLINICAL REMINDERS;**26,47,42**;Feb 04, 2005;Build 245
+2 ;
+3 ;=========================================
ENTRY ;Entry code
+1 NEW TAXIEN
+2 SET TAXIEN=^TMP("PXRMTAX",$JOB,"TAXIEN")
+3 DO INITMPG^PXRMTXLS
+4 KILL ^TMP("PXRMCODES",$JOB)
+5 DO HDR^PXRMUIDE
+6 DO CODELIST^PXRMTXSM(TAXIEN)
+7 DO BLDLIST^PXRMTXLS
+8 DO XQORM^PXRMUIDE
+9 QUIT
+10 ;
+11 ;=========================================
EXIT ;Exit code
+1 DO INITMPG^PXRMTXLS
+2 KILL ^TMP("PXRMCODES",$JOB)
+3 DO FULL^VALM1
+4 DO CLEAN^VALM10
+5 DO KILL^VALM10
+6 DO CLEAR^VALM1
+7 SET VALMBCK="Q"
+8 QUIT
+9 ;
+10 ;=========================================
EXITS ;Exit and save action.
+1 DO SAVE^PXRMUIDE
+2 DO EXIT^PXRMUIDE
+3 QUIT
+4 ;
+5 ;=========================================
HDR ; Header code
+1 SET VALMHDR(1)="Edit UID for all selected codes in this taxonomy."
+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","UID Edit Help")
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
+12 ;=========================================
HTEXT ;Lexicon selection help text. PROBABLY CAN REMOVE AND USE ORIGINAL
+1 ;;Select one of the following actions:
+2 ;;
+3 ;; RFD - removes selected codes from being used in a dialog.
+4 ;; UID - adds selected codes to the taxonomy and marks them for use in a dialog.
+5 ;; SAVE - saves all selected codes. Even if codes have been selected, they will
+6 ;; not be stored until they are saved. Finally, a save must be done when
+7 ;; exiting the ScreenMan form or no changes will be saved.
+8 ;; EXIT - saves then exits.
+9 ;;
+10 ;;You can select the action first and then be prompted for a list of codes or
+11 ;;you can input the list and then select the action. Because of the way List
+12 ;;Manager works, you may be able to select a larger list by selecting the action
+13 ;;first.
+14 ;;
+15 ;;**End Text**
+16 QUIT
+17 ;
+18 ;=========================================
PEXIT ; Protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 ;Reset after page up/down etc
+3 DO XQORM^PXRMUIDE
+4 QUIT
+5 ;
+6 ;=========================================
SAVE ;Save the changes.
+1 NEW TAXIEN
+2 SET TAXIEN=^TMP("PXRMTAX",$JOB,"TAXIEN")
+3 DO SAVE^PXRMTXLS
+4 DO POSTSAVE^PXRMTXSM(TAXIEN)
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;=========================================
XQORM ; Set range for selection.
+1 NEW NCODES
+2 SET NCODES=+$GET(^TMP("PXRMTXSC",$JOB,"NCODES"))
+3 IF NCODES=0
QUIT
+4 SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM TAXONOMY UIDE SELECT ENTRY",0))_U_"1:"_NCODES
+5 SET XQORM("A")="Select Action: "
+6 QUIT
+7 ;
+8 ;=========================================
XSEL ;Entry action for protocol PXRM TAXONOMY ALL SELECTED SELECT.
+1 NEW ENUM,IND,LIST,NCODES,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 SET NCODES=+$ORDER(^TMP("PXRMTXSC",$JOB,"LINES",""),-1)
+7 FOR IND=1:1:$LENGTH(LIST,",")
Begin DoDot:1
+8 SET ENUM=$PIECE(LIST,",",IND)
+9 IF (ENUM<1)!(ENUM>NCODES)
Begin DoDot:2
+10 WRITE !,ENUM," is not a valid selection."
+11 WRITE !,"The range is 1 to ",NCODES,"."
+12 HANG 2
+13 SET LVALID=0
End DoDot:2
End DoDot:1
+14 IF 'LVALID
SET VALMBCK="R"
QUIT
+15 ;
+16 ;Full screen mode
+17 DO FULL^VALM1
+18 ;
+19 ;Possible actions.
+20 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
+21 SET DIR(0)="SBM"_U_"RFD:Remove from dialog;"
+22 SET DIR(0)=DIR(0)_"UID:Use in dialog;"
+23 SET DIR("A")="Select Action: "
+24 SET DIR("B")="UID"
+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="RFD"
DO RFDX^PXRMTXLS(.LIST)
+33 IF OPTION="UID"
DO INCX^PXRMTXLS(.LIST,1)
+34 ;
+35 SET VALMBCK="R"
+36 QUIT
+37 ;
