Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMVSLM

PXRMVSLM.m

Go to the documentation of this file.
  1. PXRMVSLM ;SLC/PKR - List Manager routines for value sets. ;11/20/2014
  1. ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
  1. ;
  1. ;=========================================
  1. BLDLIST(NODE) ;Build of list of value set file entries.
  1. N IEN,FMTSTR,IND,OID,OIDL,NAME,NL,NUM,OUTPUT,START,UCNAME,VDATE
  1. K ^TMP(NODE,$J)
  1. ;Build the list in alphabetical order.
  1. S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL")
  1. S (NUM,VALMCNT)=0
  1. S UCNAME=""
  1. F S UCNAME=$O(^PXRM(802.2,"AUNVD",UCNAME)) Q:UCNAME="" D
  1. . S VDATE=""
  1. . F S VDATE=$O(^PXRM(802.2,"AUNVD",UCNAME,VDATE)) Q:VDATE="" D
  1. .. S IEN=""
  1. .. F S IEN=$O(^PXRM(802.2,"AUNVD",UCNAME,VDATE,IEN)) Q:IEN="" D
  1. ... S NAME=$P(^PXRM(802.2,IEN,0),U,1)
  1. ... S OID=$P(^PXRM(802.2,IEN,1),U,1)
  1. ... S OIDL(OID)=""
  1. ... S NUM=NUM+1
  1. ... S ^TMP(NODE,$J,"SEL",NUM)=IEN
  1. ... S ^TMP(NODE,$J,"IEN",IEN)=NUM
  1. ... D FORMAT(NUM,NAME,OID,VDATE,FMTSTR,.NL,.OUTPUT)
  1. ... S START=VALMCNT+1
  1. ... F IND=1:1:NL D
  1. .... S VALMCNT=VALMCNT+1,^TMP(NODE,$J,VALMCNT,0)=OUTPUT(IND)
  1. .... S ^TMP(NODE,$J,"IDX",VALMCNT,NUM)=""
  1. ... S ^TMP(NODE,$J,"LINES",NUM)=START_U_VALMCNT
  1. S ^TMP(NODE,$J,"VALMCNT")=VALMCNT
  1. S ^TMP(NODE,$J,"NVS")=NUM
  1. Q
  1. ;
  1. ;=========================================
  1. CRETAX(IEN) ;Create a taxonomy from a value set.
  1. D FULL^VALM1
  1. D BLDTAX^PXRMVSTX(IEN)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. CRETAXS(IEN) ;Select a value set for creating a taxonomy.
  1. N IEN
  1. ;Get the entry
  1. S IEN=+$$GETSEL("Select value set for creating a taxonomy")
  1. I IEN=0 S VALMBCK="R" Q
  1. D CRETAX(IEN)
  1. Q
  1. ;
  1. ;=========================================
  1. ENTRY ;Entry code
  1. D INITMPG^PXRMVSLM
  1. D BLDLIST^PXRMVSLM("PXRMVSL")
  1. D XQORM
  1. Q
  1. ;
  1. ;=========================================
  1. EXIT ;Exit code
  1. D INITMPG^PXRMVSLM
  1. D CLEAN^VALM10
  1. D FULL^VALM1
  1. S VALMBCK="Q"
  1. Q
  1. ;
  1. ;=========================================
  1. FORMAT(NUMBER,NAME,OID,VDATE,FMTSTR,NL,OUTPUT) ;Format entry number, name and
  1. ;version date for the LM display.
  1. N TEMP
  1. S TEMP=NUMBER_U_NAME_"\\"_"("_OID_")"_U_$$FMTE^XLFDT(VDATE)
  1. D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
  1. Q
  1. ;
  1. ;=========================================
  1. GETSEL(TEXT) ;Get a single selection
  1. N DIR,NVS,X,Y
  1. S NVS=+$G(^TMP("PXRMVSL",$J,"NVS"))
  1. I NVS=0 Q 0
  1. S DIR(0)="N^1:"_NVS
  1. S DIR("A")=TEXT
  1. D ^DIR
  1. Q +$G(^TMP("PXRMVSL",$J,"SEL",+Y))
  1. ;
  1. ;=========================================
  1. HELP ;Display help.
  1. N DDS,DIR0,DONE,IND,TEXT
  1. ;DBIA #5746 covers kill and set of DDS. DDS needs to be set or the
  1. ;Browser will kill some ScreenMan variables.
  1. S DDS=1,DONE=0
  1. F IND=1:1 Q:DONE D
  1. . S TEXT(IND)=$P($T(HTEXT+IND),";",3,99)
  1. . I TEXT(IND)="**End Text**" K TEXT(IND) S DONE=1 Q
  1. D BROWSE^DDBR("TEXT","NR","Value Set Management Help")
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. HDR ; Header code
  1. S VALMHDR(1)="NLM Value Sets"
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. Q
  1. ;
  1. ;=========================================
  1. HTEXT ;Taxonomy mangement help text.
  1. ;;Select one of the following actions:
  1. ;; CT - create a taxonomy from a value set.
  1. ;; INQ - value set inquiry.
  1. ;; CS - code search, list all value sets containing a specified code.
  1. ;;
  1. ;;You can select the action first and then the entry or choose the entry and then
  1. ;;the action.
  1. ;;
  1. ;;**End Text**
  1. Q
  1. ;
  1. ;=========================================
  1. INQ(IEN) ;Display the contents of a value set.
  1. D BVSINQ^PXRMVSIN(IEN)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;=========================================
  1. INQS ;Inquiry for a selected value set.
  1. N IEN
  1. ;Get the entry
  1. S IEN=+$$GETSEL("Select the value set")
  1. I IEN=0 S VALMBCK="R" Q
  1. D INQ^PXRMVSLM(IEN)
  1. Q
  1. ;
  1. ;=========================================
  1. INITMPG ;Initialize all the ^TMP globals.
  1. K ^TMP("PXRMVSL",$J)
  1. Q
  1. ;
  1. ;=========================================
  1. PEXIT ; Protocol exit code
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. ;Reset after page up/down etc
  1. D XQORM
  1. Q
  1. ;
  1. ;=========================================
  1. START ;Main entry point for PXRM Value Set Menu.
  1. N VALMBCK,VALMSG,X
  1. S X="IORESET"
  1. D ENDR^%ZISS
  1. D EN^VALM("PXRM VS MENU")
  1. W IORESET
  1. D KILL^%ZISS
  1. Q
  1. ;
  1. ;=========================================
  1. XQORM ;Set range for selection.
  1. N NVS
  1. S NVS=^TMP("PXRMVSL",$J,"NVS")
  1. S XQORM("#")=$O(^ORD(101,"B","PXRM VS SELECT ENTRY",0))_U_"1:"_NVS
  1. S XQORM("A")="Select Action: "
  1. Q
  1. ;
  1. ;=========================================
  1. XSEL ;Entry action for protocol PXRM VS SELECT ENTRY.
  1. N IEN,SEL
  1. S SEL=$P(XQORNOD(0),"=",2)
  1. ;Remove trailing ,
  1. I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
  1. ;Invalid selection
  1. I SEL["," D Q
  1. . W !,"Only one item number allowed." H 2
  1. . S VALMBCK="R"
  1. I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
  1. . W !,SEL_" is not a valid item number." H 2
  1. . S VALMBCK="R"
  1. ;
  1. ;Get the IEN.
  1. S IEN=^TMP("PXRMVSL",$J,"SEL",SEL)
  1. ;
  1. ;Full screen mode
  1. D FULL^VALM1
  1. ;
  1. ;Action list.
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
  1. S DIR(0)="SBM"_U
  1. S DIR(0)=DIR(0)_"CT:Create Taxonomy;"
  1. S DIR(0)=DIR(0)_"INQ:Inquire;"
  1. S DIR("A")="Select Action: "
  1. S DIR("B")="INQ"
  1. S DIR("?")="Select from the actions displayed."
  1. D ^DIR
  1. I $D(DIROUT)!$D(DIRUT) S VALMBCK="R" Q
  1. I $D(DTOUT)!$D(DUOUT) S VALMBCK="R" Q
  1. S OPTION=Y
  1. D CLEAR^VALM1
  1. ;
  1. I OPTION="CT" D CRETAX^PXRMVSLM(IEN)
  1. I OPTION="INQ" D INQ^PXRMVSLM(IEN)
  1. S VALMBCK="R"
  1. Q
  1. ;