BDGFL ; IHS/ANMC/LJF - GENERAL LIST MGR FUNCTIONS ; [ 02/20/2003 8:43 AM ]
;;5.3;PIMS;;APR 26, 2002
;
GETITEM(SUB,MODE) ; -- select item from list
NEW X,Y,Z,RESULT
S RESULT=""
D EN^VALM2(XQORNOD(0),MODE)
I '$D(VALMY) Q 0 ;IHS/ITSC/WAR 2/19/03 added the zero '0' WAR11 P52
S X=0 F S X=$O(VALMY(X)) Q:X="" D
. S Y=0 F S Y=$O(^TMP(SUB,$J,"IDX",Y)) Q:Y="" D
.. S Z=$O(^TMP(SUB,$J,"IDX",Y,0))
.. Q:^TMP(SUB,$J,"IDX",Y,Z)=""
.. I Z=X S RESULT=RESULT_^TMP(SUB,$J,"IDX",Y,Z)_","
Q RESULT
;
RETURN ;EP; -- reset listman
D TERM^VALM0 S VALMBCK="R" Q
;
LMKILL ;EP; -- kills IO and VALM variables used by List Manager
D KILL^%ZISS,EN^XBVK("VALM"),EN^XBVK("XQOR")
Q
;
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BDGFL ; IHS/ANMC/LJF - GENERAL LIST MGR FUNCTIONS ; [ 02/20/2003 8:43 AM ]
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
GETITEM(SUB,MODE) ; -- select item from list
+1 NEW X,Y,Z,RESULT
+2 SET RESULT=""
+3 DO EN^VALM2(XQORNOD(0),MODE)
+4 ;IHS/ITSC/WAR 2/19/03 added the zero '0' WAR11 P52
IF '$DATA(VALMY)
QUIT 0
+5 SET X=0
FOR
SET X=$ORDER(VALMY(X))
IF X=""
QUIT
Begin DoDot:1
+6 SET Y=0
FOR
SET Y=$ORDER(^TMP(SUB,$JOB,"IDX",Y))
IF Y=""
QUIT
Begin DoDot:2
+7 SET Z=$ORDER(^TMP(SUB,$JOB,"IDX",Y,0))
+8 IF ^TMP(SUB,$JOB,"IDX",Y,Z)=""
QUIT
+9 IF Z=X
SET RESULT=RESULT_^TMP(SUB,$JOB,"IDX",Y,Z)_","
End DoDot:2
End DoDot:1
+10 QUIT RESULT
+11 ;
RETURN ;EP; -- reset listman
+1 DO TERM^VALM0
SET VALMBCK="R"
QUIT
+2 ;
LMKILL ;EP; -- kills IO and VALM variables used by List Manager
+1 DO KILL^%ZISS
DO EN^XBVK("VALM")
DO EN^XBVK("XQOR")
+2 QUIT
+3 ;
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)