- 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 Dec 13, 2024@02:05:59 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