- 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
- Q
- ;
- ;=========================================
- CRETAX(IEN) ;Create a taxonomy from a value set.
- D FULL^VALM1
- D BLDTAX^PXRMVSTX(IEN)
- S VALMBCK="R"
- Q
- ;
- ;=========================================
- 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)
- Q
- ;
- ;=========================================
- ENTRY ;Entry code
- D INITMPG^PXRMVSLM
- D BLDLIST^PXRMVSLM("PXRMVSL")
- D XQORM
- Q
- ;
- ;=========================================
- EXIT ;Exit code
- D INITMPG^PXRMVSLM
- D CLEAN^VALM10
- D FULL^VALM1
- S VALMBCK="Q"
- 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)
- Q
- ;
- ;=========================================
- 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"
- Q
- ;
- ;=========================================
- HDR ; Header code
- S VALMHDR(1)="NLM Value Sets"
- S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- Q
- ;
- ;=========================================
- 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**
- Q
- ;
- ;=========================================
- INQ(IEN) ;Display the contents of a value set.
- D BVSINQ^PXRMVSIN(IEN)
- S VALMBCK="R"
- Q
- ;
- ;=========================================
- 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)
- Q
- ;
- ;=========================================
- INITMPG ;Initialize all the ^TMP globals.
- K ^TMP("PXRMVSL",$J)
- Q
- ;
- ;=========================================
- PEXIT ; Protocol exit code
- S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- ;Reset after page up/down etc
- D XQORM
- Q
- ;
- ;=========================================
- 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
- Q
- ;
- ;=========================================
- 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: "
- Q
- ;
- ;=========================================
- 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"
- Q
- ;
- --- 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 ;