LR7OV5 ;DALOI/JMC - Lab XPAR Parameter Utility;02/28/12 20:44
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
;
LISTPAR ; List user-level values for a parameter
;
N DIR,DIRUT,DDTOUT,UOUT,LN,LRENTITY,LRERR,LROUT,LRPAR,LRREF,LRXPAR,LRXPARLIST
;
; Select a parameter to display
F D Q:LRXPAR<0!(LRXPAR>0)
. K LRXPAR
. D GETPAR^XPAREDIT(.LRXPAR)
. I $E($P(LRXPAR,"^",2),1,2)?1(1"LR",1"LA") Q
. I LRXPAR>0 W !!,"*** Please select a PARAMETER within the Laboratory Namespace (LA/LR) ***" S LRXPAR=0
. E S LRXPAR=-1
I LRXPAR<1 Q
;
; Return all parameter instances
D ENVAL^XPAR(.LRXPARLIST,+LRXPAR,"",.LRERR)
I LRERR W !,"Error encountered: "_LRERR Q
;
; Build list of entities allowed for this parameter
D BLDLST^XPAREDIT(.LRPAR,+LRXPAR)
;
W !!,"Values for "_$P(LRXPAR,"^",2),!
D HEADER
;
S LRREF="",LN=1
F S LRREF=$O(LRXPARLIST(LRREF)) Q:LRREF="" D Q:$D(DIRUT)
. I $P(LRREF,";",2)'="VA(200," Q
. D ENTITY
. K LROUT
. D GETLST^XPAR(.LROUT,LRREF,+LRXPAR,"N",.LRERR)
. S LROUT=""
. F S LROUT=$O(LROUT(LROUT)) Q:LROUT="" D Q:$D(DIRUT)
. . D WAIT Q:$D(DIRUT)
. . W !,$E(LRENTITY,1,30)
. . W ?31,$E(LROUT,1,20),?52,$E($P(LROUT(LROUT),"^",2),1,28)
;
I '$D(DIRUT) S DIR("A")="Enter RETURN to continue",DIR(0)="E" D ^DIR
;
Q
;
;
;
ENTITY ; Resolve entity
;
S LRENTITY=""
I $P(LRREF,";",2)="VA(200," S LRENTITY="USR: "_$$NAME^XUSER(+LRREF,"F") Q
I $P(LRREF,";",2)="DIC(9.4," S LRENTITY="PKG: "_$$GET1^DIQ(9.4,+LRREF_",",.01) Q
I $P(LRREF,";",2)="DIC(4," S LRENTITY="DIV: "_$P($$NS^XUAF4(+LRREF),"^") Q
;
I $P(LRREF,";",2)="DIC(4.2," D Q
. N X
. S X=$G(LRPAR("P","SYS"))
. I X,$P(LRPAR(X),"^",6)'="" S LRENTITY="SYS: "_$P(LRPAR(X),"^",6) Q
. S LRENTITY="SYS: "_LRREF Q
;
I $P(LRREF,";",2)="DIC(49," S LRENTITY="SRV: "_$$GET1^DIQ(49,+LRREF_",",.01) Q
I $P(LRREF,";",2)="SC(" S LRENTITY="LOC: "_$$GET1^DIQ(44,+LRREF_",",.01) Q
;
I $P(LRREF,";",2)="SCTM(404.51," S LRENTITY="TEA: "_LRREF Q
I $P(LRREF,";",2)="USR(8930," S LRENTITY="CLS: "_LRREF Q
I $P(LRREF,";",2)="DG(405.4," S LRENTITY="BED: "_LRREF Q
I $P(LRREF,";",2)="OR(100.21," S LRENTITY="OTL: "_LRREF Q
;
; Default value if not handled.
S LRENTITY=LRREF
Q
;
;
WAIT ; pause display
;
;
S LN=LN+1
I LN>(IOSL-4) S DIR(0)="E" D ^DIR W !! D:'$D(DIRUT) HEADER S LN=0
Q
;
;
W !,"Parameter",?31,"Instance",?52,"Value",!
W $$REPEAT^XLFSTR("-",IOM-4),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OV5 2467 printed Sep 23, 2025@19:41:39 Page 2
LR7OV5 ;DALOI/JMC - Lab XPAR Parameter Utility;02/28/12 20:44
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 ;
LISTPAR ; List user-level values for a parameter
+1 ;
+2 NEW DIR,DIRUT,DDTOUT,UOUT,LN,LRENTITY,LRERR,LROUT,LRPAR,LRREF,LRXPAR,LRXPARLIST
+3 ;
+4 ; Select a parameter to display
+5 FOR
Begin DoDot:1
+6 KILL LRXPAR
+7 DO GETPAR^XPAREDIT(.LRXPAR)
+8 IF $EXTRACT($PIECE(LRXPAR,"^",2),1,2)?1(1"LR",1"LA")
QUIT
+9 IF LRXPAR>0
WRITE !!,"*** Please select a PARAMETER within the Laboratory Namespace (LA/LR) ***"
SET LRXPAR=0
+10 IF '$TEST
SET LRXPAR=-1
End DoDot:1
if LRXPAR<0!(LRXPAR>0)
QUIT
+11 IF LRXPAR<1
QUIT
+12 ;
+13 ; Return all parameter instances
+14 DO ENVAL^XPAR(.LRXPARLIST,+LRXPAR,"",.LRERR)
+15 IF LRERR
WRITE !,"Error encountered: "_LRERR
QUIT
+16 ;
+17 ; Build list of entities allowed for this parameter
+18 DO BLDLST^XPAREDIT(.LRPAR,+LRXPAR)
+19 ;
+20 WRITE !!,"Values for "_$PIECE(LRXPAR,"^",2),!
+21 DO HEADER
+22 ;
+23 SET LRREF=""
SET LN=1
+24 FOR
SET LRREF=$ORDER(LRXPARLIST(LRREF))
if LRREF=""
QUIT
Begin DoDot:1
+25 IF $PIECE(LRREF,";",2)'="VA(200,"
QUIT
+26 DO ENTITY
+27 KILL LROUT
+28 DO GETLST^XPAR(.LROUT,LRREF,+LRXPAR,"N",.LRERR)
+29 SET LROUT=""
+30 FOR
SET LROUT=$ORDER(LROUT(LROUT))
if LROUT=""
QUIT
Begin DoDot:2
+31 DO WAIT
if $DATA(DIRUT)
QUIT
+32 WRITE !,$EXTRACT(LRENTITY,1,30)
+33 WRITE ?31,$EXTRACT(LROUT,1,20),?52,$EXTRACT($PIECE(LROUT(LROUT),"^",2),1,28)
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+34 ;
+35 IF '$DATA(DIRUT)
SET DIR("A")="Enter RETURN to continue"
SET DIR(0)="E"
DO ^DIR
+36 ;
+37 QUIT
+38 ;
+39 ;
+40 ;
ENTITY ; Resolve entity
+1 ;
+2 SET LRENTITY=""
+3 IF $PIECE(LRREF,";",2)="VA(200,"
SET LRENTITY="USR: "_$$NAME^XUSER(+LRREF,"F")
QUIT
+4 IF $PIECE(LRREF,";",2)="DIC(9.4,"
SET LRENTITY="PKG: "_$$GET1^DIQ(9.4,+LRREF_",",.01)
QUIT
+5 IF $PIECE(LRREF,";",2)="DIC(4,"
SET LRENTITY="DIV: "_$PIECE($$NS^XUAF4(+LRREF),"^")
QUIT
+6 ;
+7 IF $PIECE(LRREF,";",2)="DIC(4.2,"
Begin DoDot:1
+8 NEW X
+9 SET X=$GET(LRPAR("P","SYS"))
+10 IF X
IF $PIECE(LRPAR(X),"^",6)'=""
SET LRENTITY="SYS: "_$PIECE(LRPAR(X),"^",6)
QUIT
+11 SET LRENTITY="SYS: "_LRREF
QUIT
End DoDot:1
QUIT
+12 ;
+13 IF $PIECE(LRREF,";",2)="DIC(49,"
SET LRENTITY="SRV: "_$$GET1^DIQ(49,+LRREF_",",.01)
QUIT
+14 IF $PIECE(LRREF,";",2)="SC("
SET LRENTITY="LOC: "_$$GET1^DIQ(44,+LRREF_",",.01)
QUIT
+15 ;
+16 IF $PIECE(LRREF,";",2)="SCTM(404.51,"
SET LRENTITY="TEA: "_LRREF
QUIT
+17 IF $PIECE(LRREF,";",2)="USR(8930,"
SET LRENTITY="CLS: "_LRREF
QUIT
+18 IF $PIECE(LRREF,";",2)="DG(405.4,"
SET LRENTITY="BED: "_LRREF
QUIT
+19 IF $PIECE(LRREF,";",2)="OR(100.21,"
SET LRENTITY="OTL: "_LRREF
QUIT
+20 ;
+21 ; Default value if not handled.
+22 SET LRENTITY=LRREF
+23 QUIT
+24 ;
+25 ;
WAIT ; pause display
+1 ;
+2 ;
+3 SET LN=LN+1
+4 IF LN>(IOSL-4)
SET DIR(0)="E"
DO ^DIR
WRITE !!
if '$DATA(DIRUT)
DO HEADER
SET LN=0
+5 QUIT
+6 ;
+7 ;
+1 WRITE !,"Parameter",?31,"Instance",?52,"Value",!
+2 WRITE $$REPEAT^XLFSTR("-",IOM-4),!
+3 QUIT
