- 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 Feb 18, 2025@23:16:04 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 ;