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 Dec 13, 2024@01:50:02 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 ;
