Routine: PXRMVSLM

PXRMVSLM ;SLC/PKR - List Manager routines for value sets. ;11/20/2014

 ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291

 ;=========================================

BLDLIST(NODE) ;Build of list of value set file entries.

 N IEN,FMTSTR,IND,OID,OIDL,NAME,NL,NUM,OUTPUT,START,UCNAME,VDATE

 K ^TMP(NODE,$J)

 ;Build the list in alphabetical order.

 S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL")

 S (NUM,VALMCNT)=0

 S UCNAME=""

 F  S UCNAME=$O(^PXRM(802.2,"AUNVD",UCNAME)) Q:UCNAME=""  D

 . S VDATE=""

 . F  S VDATE=$O(^PXRM(802.2,"AUNVD",UCNAME,VDATE)) Q:VDATE=""  D

 .. S IEN=""

 .. F  S IEN=$O(^PXRM(802.2,"AUNVD",UCNAME,VDATE,IEN)) Q:IEN=""  D

 ... S NAME=$P(^PXRM(802.2,IEN,0),U,1)

 ... S OID=$P(^PXRM(802.2,IEN,1),U,1)

 ... S OIDL(OID)=""

 ... S NUM=NUM+1

 ... S ^TMP(NODE,$J,"SEL",NUM)=IEN

 ... S ^TMP(NODE,$J,"IEN",IEN)=NUM

 ... D FORMAT(NUM,NAME,OID,VDATE,FMTSTR,.NL,.OUTPUT)

 ... S START=VALMCNT+1

 ... F IND=1:1:NL D

 .... S VALMCNT=VALMCNT+1,^TMP(NODE,$J,VALMCNT,0)=OUTPUT(IND)

 .... S ^TMP(NODE,$J,"IDX",VALMCNT,NUM)=""

 ... S ^TMP(NODE,$J,"LINES",NUM)=START_U_VALMCNT

 S ^TMP(NODE,$J,"VALMCNT")=VALMCNT

 S ^TMP(NODE,$J,"NVS")=NUM

 ;=========================================

CRETAX(IEN) ;Create a taxonomy from a value set.

 D FULL^VALM1

 D BLDTAX^PXRMVSTX(IEN)

 S VALMBCK="R"

 ;=========================================

CRETAXS(IEN) ;Select a value set for creating a taxonomy.

 N IEN

 ;Get the entry

 S IEN=+$$GETSEL("Select value set for creating a taxonomy")

 I IEN=0 S VALMBCK="R" Q

 D CRETAX(IEN)

 ;=========================================

ENTRY ;Entry code

 D INITMPG^PXRMVSLM

 D BLDLIST^PXRMVSLM("PXRMVSL")

 D XQORM

 ;=========================================

EXIT ;Exit code

 D INITMPG^PXRMVSLM

 D CLEAN^VALM10

 D FULL^VALM1

 S VALMBCK="Q"

 ;=========================================

FORMAT(NUMBER,NAME,OID,VDATE,FMTSTR,NL,OUTPUT) ;Format entry number, name and

 ;version date for the LM display.

 N TEMP

 S TEMP=NUMBER_U_NAME_"\\"_"("_OID_")"_U_$$FMTE^XLFDT(VDATE)

 D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)

 ;=========================================

GETSEL(TEXT) ;Get a single selection

 N DIR,NVS,X,Y

 S NVS=+$G(^TMP("PXRMVSL",$J,"NVS"))

 I NVS=0 Q 0

 S DIR(0)="N^1:"_NVS

 S DIR("A")=TEXT

 D ^DIR

 Q +$G(^TMP("PXRMVSL",$J,"SEL",+Y))

 ;=========================================

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","Value Set Management Help")

 S VALMBCK="R"

 ;=========================================

HDR ; Header code

 S VALMHDR(1)="NLM Value Sets"

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 ;=========================================

HTEXT ;Taxonomy mangement help text.

 ;;Select one of the following actions:

 ;; CT  - create a taxonomy from a value set.

 ;; INQ - value set inquiry.

 ;; CS  - code search, list all value sets containing a specified code.

;;

 ;;You can select the action first and then the entry or choose the entry and then

 ;;the action.

;;

 ;;**End Text**

 ;=========================================

INQ(IEN) ;Display the contents of a value set.

 D BVSINQ^PXRMVSIN(IEN)

 S VALMBCK="R"

 ;=========================================

INQS ;Inquiry for a selected value set.

 N IEN

 ;Get the entry

 S IEN=+$$GETSEL("Select the value set")

 I IEN=0 S VALMBCK="R" Q

 D INQ^PXRMVSLM(IEN)

 ;=========================================

INITMPG ;Initialize all the ^TMP globals.

 K ^TMP("PXRMVSL",$J)

 ;=========================================

PEXIT ; Protocol exit code

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 ;Reset after page up/down etc

 D XQORM

 ;=========================================

START ;Main entry point for PXRM Value Set Menu.

 N VALMBCK,VALMSG,X

 S X="IORESET"

 D ENDR^%ZISS

 D EN^VALM("PXRM VS MENU")

 W IORESET

 D KILL^%ZISS

 ;=========================================

XQORM ;Set range for selection.

 N NVS

 S NVS=^TMP("PXRMVSL",$J,"NVS")

 S XQORM("#")=$O(^ORD(101,"B","PXRM VS SELECT ENTRY",0))_U_"1:"_NVS

 S XQORM("A")="Select Action: "

 ;=========================================

XSEL ;Entry action for protocol PXRM VS SELECT 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("PXRMVSL",$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)_"CT:Create Taxonomy;"

 S DIR(0)=DIR(0)_"INQ:Inquire;"

 S DIR("A")="Select Action: "

 S DIR("B")="INQ"

 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="CT" D CRETAX^PXRMVSLM(IEN)

 I OPTION="INQ" D INQ^PXRMVSLM(IEN)

 S VALMBCK="R"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMVSLM   5489     printed  Feb 18, 2025@23:16:25                                                                                                                                                                                                    Page 2

PXRMVSLM  ;SLC/PKR - List Manager routines for value sets. ;11/20/2014

 +1       ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291

 +2       ;

 +3       ;=========================================

BLDLIST(NODE) ;Build of list of value set file entries.

 +1        NEW IEN,FMTSTR,IND,OID,OIDL,NAME,NL,NUM,OUTPUT,START,UCNAME,VDATE

 +2        KILL ^TMP(NODE,$JOB)

 +3       ;Build the list in alphabetical order.

 +4        SET FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL")

 +5        SET (NUM,VALMCNT)=0

 +6        SET UCNAME=""

 +7        FOR

               SET UCNAME=$ORDER(^PXRM(802.2,"AUNVD",UCNAME))

               if UCNAME=""

                   QUIT

               Begin DoDot:1

 +8                SET VDATE=""

 +9                FOR

                       SET VDATE=$ORDER(^PXRM(802.2,"AUNVD",UCNAME,VDATE))

                       if VDATE=""

                           QUIT

                       Begin DoDot:2

 +10                       SET IEN=""

 +11                       FOR

                               SET IEN=$ORDER(^PXRM(802.2,"AUNVD",UCNAME,VDATE,IEN))

                               if IEN=""

                                   QUIT

                               Begin DoDot:3

 +12                               SET NAME=$PIECE(^PXRM(802.2,IEN,0),U,1)

 +13                               SET OID=$PIECE(^PXRM(802.2,IEN,1),U,1)

 +14                               SET OIDL(OID)=""

 +15                               SET NUM=NUM+1

 +16                               SET ^TMP(NODE,$JOB,"SEL",NUM)=IEN

 +17                               SET ^TMP(NODE,$JOB,"IEN",IEN)=NUM

 +18                               DO FORMAT(NUM,NAME,OID,VDATE,FMTSTR,.NL,.OUTPUT)

 +19                               SET START=VALMCNT+1

 +20                               FOR IND=1:1:NL

                                       Begin DoDot:4

 +21                                       SET VALMCNT=VALMCNT+1

                                           SET ^TMP(NODE,$JOB,VALMCNT,0)=OUTPUT(IND)

 +22                                       SET ^TMP(NODE,$JOB,"IDX",VALMCNT,NUM)=""

                                       End DoDot:4

 +23                               SET ^TMP(NODE,$JOB,"LINES",NUM)=START_U_VALMCNT

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +24       SET ^TMP(NODE,$JOB,"VALMCNT")=VALMCNT

 +25       SET ^TMP(NODE,$JOB,"NVS")=NUM

 +26       QUIT

 +27      ;

 +28      ;=========================================

CRETAX(IEN) ;Create a taxonomy from a value set.

 +1        DO FULL^VALM1

 +2        DO BLDTAX^PXRMVSTX(IEN)

 +3        SET VALMBCK="R"

 +4        QUIT

 +5       ;

 +6       ;=========================================

CRETAXS(IEN) ;Select a value set for creating a taxonomy.

 +1        NEW IEN

 +2       ;Get the entry

 +3        SET IEN=+$$GETSEL("Select value set for creating a taxonomy")

 +4        IF IEN=0

               SET VALMBCK="R"

               QUIT

 +5        DO CRETAX(IEN)

 +6        QUIT

 +7       ;

 +8       ;=========================================

ENTRY     ;Entry code

 +1        DO INITMPG^PXRMVSLM

 +2        DO BLDLIST^PXRMVSLM("PXRMVSL")

 +3        DO XQORM

 +4        QUIT

 +5       ;

 +6       ;=========================================

EXIT      ;Exit code

 +1        DO INITMPG^PXRMVSLM

 +2        DO CLEAN^VALM10

 +3        DO FULL^VALM1

 +4        SET VALMBCK="Q"

 +5        QUIT

 +6       ;

 +7       ;=========================================

FORMAT(NUMBER,NAME,OID,VDATE,FMTSTR,NL,OUTPUT) ;Format entry number, name and

 +1       ;version date for the LM display.

 +2        NEW TEMP

 +3        SET TEMP=NUMBER_U_NAME_"\\"_"("_OID_")"_U_$$FMTE^XLFDT(VDATE)

 +4        DO COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)

 +5        QUIT

 +6       ;

 +7       ;=========================================

GETSEL(TEXT) ;Get a single selection

 +1        NEW DIR,NVS,X,Y

 +2        SET NVS=+$GET(^TMP("PXRMVSL",$JOB,"NVS"))

 +3        IF NVS=0

               QUIT 0

 +4        SET DIR(0)="N^1:"_NVS

 +5        SET DIR("A")=TEXT

 +6        DO ^DIR

 +7        QUIT +$GET(^TMP("PXRMVSL",$JOB,"SEL",+Y))

 +8       ;

 +9       ;=========================================

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","Value Set Management Help")

 +9        SET VALMBCK="R"

 +10       QUIT

 +11      ;

 +12      ;=========================================

HDR       ; Header code

 +1        SET VALMHDR(1)="NLM Value Sets"

 +2        SET VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 +3        QUIT

 +4       ;

 +5       ;=========================================

HTEXT     ;Taxonomy mangement help text.

 +1       ;;Select one of the following actions:

 +2       ;; CT  - create a taxonomy from a value set.

 +3       ;; INQ - value set inquiry.

 +4       ;; CS  - code search, list all value sets containing a specified code.

 +5       ;;

 +6       ;;You can select the action first and then the entry or choose the entry and then

 +7       ;;the action.

 +8       ;;

 +9       ;;**End Text**

 +10       QUIT

 +11      ;

 +12      ;=========================================

INQ(IEN)  ;Display the contents of a value set.

 +1        DO BVSINQ^PXRMVSIN(IEN)

 +2        SET VALMBCK="R"

 +3        QUIT

 +4       ;

 +5       ;=========================================

INQS      ;Inquiry for a selected value set.

 +1        NEW IEN

 +2       ;Get the entry

 +3        SET IEN=+$$GETSEL("Select the value set")

 +4        IF IEN=0

               SET VALMBCK="R"

               QUIT

 +5        DO INQ^PXRMVSLM(IEN)

 +6        QUIT

 +7       ;

 +8       ;=========================================

INITMPG   ;Initialize all the ^TMP globals.

 +1        KILL ^TMP("PXRMVSL",$JOB)

 +2        QUIT

 +3       ;

 +4       ;=========================================

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       ;=========================================

START     ;Main entry point for PXRM Value Set Menu.

 +1        NEW VALMBCK,VALMSG,X

 +2        SET X="IORESET"

 +3        DO ENDR^%ZISS

 +4        DO EN^VALM("PXRM VS MENU")

 +5        WRITE IORESET

 +6        DO KILL^%ZISS

 +7        QUIT

 +8       ;

 +9       ;=========================================

XQORM     ;Set range for selection.

 +1        NEW NVS

 +2        SET NVS=^TMP("PXRMVSL",$JOB,"NVS")

 +3        SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM VS SELECT ENTRY",0))_U_"1:"_NVS

 +4        SET XQORM("A")="Select Action: "

 +5        QUIT

 +6       ;

 +7       ;=========================================

XSEL      ;Entry action for protocol PXRM VS SELECT 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("PXRMVSL",$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)_"CT:Create Taxonomy;"

 +23       SET DIR(0)=DIR(0)_"INQ:Inquire;"

 +24       SET DIR("A")="Select Action: "

 +25       SET DIR("B")="INQ"

 +26       SET DIR("?")="Select from the actions displayed."

 +27       DO ^DIR

 +28       IF $DATA(DIROUT)!$DATA(DIRUT)

               SET VALMBCK="R"

               QUIT

 +29       IF $DATA(DTOUT)!$DATA(DUOUT)

               SET VALMBCK="R"

               QUIT

 +30       SET OPTION=Y

 +31       DO CLEAR^VALM1

 +32      ;

 +33       IF OPTION="CT"

               DO CRETAX^PXRMVSLM(IEN)

 +34       IF OPTION="INQ"

               DO INQ^PXRMVSLM(IEN)

 +35       SET VALMBCK="R"

 +36       QUIT

 +37      ;

PXRMVSLM.m