XPARLIST ; SLC/KCM - List parameter values ;8/30/07 16:27
;;7.3;TOOLKIT;**26,72,109**;Apr 25, 1995;Build 5
;
ALLPARS ; Select parameter and list values
N PAR
D GETPAR^XPAREDIT(.PAR) Q:'PAR
D ALLPAR(+PAR)
Q
ALLPAR(PAR) ; List values given parameter
N ENT,INST,VAL,LN,DIRUT,DUOUT,DTOUT
W !!,"Values for "_$P(^XTV(8989.51,PAR,0),U),!! S LN=1
D HEADER
S ENT=0 F S ENT=$O(^XTV(8989.5,"AC",PAR,ENT)) Q:'ENT D Q:$D(DIRUT)
. S INST=""
. F S INST=$O(^XTV(8989.5,"AC",PAR,ENT,INST)) Q:INST="" D Q:$D(DIRUT)
. . D WAIT Q:$D(DIRUT)
. . S VAL=^XTV(8989.5,"AC",PAR,ENT,INST)
. . W $E($$ENTNAME(ENT),1,30),?31
. . W $E($$EXT^XPARDD(INST,PAR,"I"),1,20),?52
. . W $E($$EXT^XPARDD(VAL,PAR,"V"),1,28),!
I '$D(DIRUT) S DIR(0)="E" D ^DIR
Q
ALLENTS ; Select entity and list values
N PAR,ENT
S PAR=$O(^XTV(8989.51,"B","XPAR ALL ENTITIES",0))
D GETENT^XPAREDIT(.ENT,PAR_"^Entities") Q:'ENT
D ALLENT(ENT)
Q
ALLPKG ; Select package
N DIC,Y
S DIC=9.4,DIC(0)="AEMQ" D ^DIC Q:Y<0
D ALLENT(+Y_";DIC(9.4,")
Q
ALLENT(ENT) ; List values given entity
N IEN,PAR,INST,VAL,LN,DIRUT,DUOUT,DTOUT
K ^TMP($J)
W !!,"Values for "_$$ENTNAME(ENT),!! S LN=1
D HEADER
S IEN=0 F S IEN=$O(^XTV(8989.5,"B",ENT,IEN)) Q:'IEN D
. S X=^XTV(8989.5,IEN,0),VAL=$G(^XTV(8989.5,IEN,1)) ;p109
. Q:($P(X,U,2)="")!($P(X,U,3)="")
. S ^TMP($J,$P(X,U,2),$P(X,U,3))=VAL
. S ^TMP($J,$P(X,U,2),$P(X,U,3),IEN)=""
S PAR=0 F S PAR=$O(^TMP($J,PAR)) Q:'PAR D Q:$D(DIRUT)
. I '$D(^XTV(8989.51,PAR)) W ">> BROKEN PTR TO PARAMETER ("_PAR_")",! Q
. S INST="" F S INST=$O(^TMP($J,PAR,INST)) Q:INST="" D Q:$D(DIRUT)
. . D WAIT Q:$D(DIRUT)
. . S VAL=^TMP($J,PAR,INST)
. . W $E($P(^XTV(8989.51,PAR,0),U),1,30),?31
. . W $E($$EXT^XPARDD(INST,PAR,"I"),1,20),?52
. . W $E($$EXT^XPARDD(VAL,PAR,"V"),1,28),!
I '$D(DIRUT) S DIR(0)="E" D ^DIR
K ^TMP($J)
Q
TMPLT(TLT) ; List values given template
N DIC,Y,ALLENT,ALLINST,DTOUT,DUOUT,DIRUT
I '$G(TLT),$L($G(TLT)) S TLT=$O(^XTV(8989.52,"B",TLT,0))
I '$D(^XTV(8989.52,+$G(TLT),0)) N TLT S DIC=8989.52,DIC(0)="AEMQ" D ^DIC Q:Y<0 S TLT=+Y
D SELENT^XPAREDT3(.ALLENT,TLT) Q:$D(DTOUT)!$D(DUOUT)
D SELINST^XPAREDT3(.ALLINST,ALLENT,TLT) Q:$D(DTOUT)!$D(DUOUT)
D SHWTLT^XPAREDT3(ALLENT,ALLINST,TLT)
S DIR(0)="E" D ^DIR
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
ENTNAME(ENT) ; Return TYP: Entity
N X,FN
S FN=+$P(@(U_$P(ENT,";",2)_"0)"),U,2),X=$P(^XTV(8989.518,FN,0),U,2)
S X=X_": "_$$EXTPTR^XPARDD(+ENT,FN)
Q X
;
W "Parameter",?31,"Instance",?52,"Value",!
W $$REPEAT^XLFSTR("-",IOM-4),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPARLIST 2662 printed Dec 13, 2024@02:40:22 Page 2
XPARLIST ; SLC/KCM - List parameter values ;8/30/07 16:27
+1 ;;7.3;TOOLKIT;**26,72,109**;Apr 25, 1995;Build 5
+2 ;
ALLPARS ; Select parameter and list values
+1 NEW PAR
+2 DO GETPAR^XPAREDIT(.PAR)
if 'PAR
QUIT
+3 DO ALLPAR(+PAR)
+4 QUIT
ALLPAR(PAR) ; List values given parameter
+1 NEW ENT,INST,VAL,LN,DIRUT,DUOUT,DTOUT
+2 WRITE !!,"Values for "_$PIECE(^XTV(8989.51,PAR,0),U),!!
SET LN=1
+3 DO HEADER
+4 SET ENT=0
FOR
SET ENT=$ORDER(^XTV(8989.5,"AC",PAR,ENT))
if 'ENT
QUIT
Begin DoDot:1
+5 SET INST=""
+6 FOR
SET INST=$ORDER(^XTV(8989.5,"AC",PAR,ENT,INST))
if INST=""
QUIT
Begin DoDot:2
+7 DO WAIT
if $DATA(DIRUT)
QUIT
+8 SET VAL=^XTV(8989.5,"AC",PAR,ENT,INST)
+9 WRITE $EXTRACT($$ENTNAME(ENT),1,30),?31
+10 WRITE $EXTRACT($$EXT^XPARDD(INST,PAR,"I"),1,20),?52
+11 WRITE $EXTRACT($$EXT^XPARDD(VAL,PAR,"V"),1,28),!
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+12 IF '$DATA(DIRUT)
SET DIR(0)="E"
DO ^DIR
+13 QUIT
ALLENTS ; Select entity and list values
+1 NEW PAR,ENT
+2 SET PAR=$ORDER(^XTV(8989.51,"B","XPAR ALL ENTITIES",0))
+3 DO GETENT^XPAREDIT(.ENT,PAR_"^Entities")
if 'ENT
QUIT
+4 DO ALLENT(ENT)
+5 QUIT
ALLPKG ; Select package
+1 NEW DIC,Y
+2 SET DIC=9.4
SET DIC(0)="AEMQ"
DO ^DIC
if Y<0
QUIT
+3 DO ALLENT(+Y_";DIC(9.4,")
+4 QUIT
ALLENT(ENT) ; List values given entity
+1 NEW IEN,PAR,INST,VAL,LN,DIRUT,DUOUT,DTOUT
+2 KILL ^TMP($JOB)
+3 WRITE !!,"Values for "_$$ENTNAME(ENT),!!
SET LN=1
+4 DO HEADER
+5 SET IEN=0
FOR
SET IEN=$ORDER(^XTV(8989.5,"B",ENT,IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 ;p109
SET X=^XTV(8989.5,IEN,0)
SET VAL=$GET(^XTV(8989.5,IEN,1))
+7 if ($PIECE(X,U,2)="")!($PIECE(X,U,3)="")
QUIT
+8 SET ^TMP($JOB,$PIECE(X,U,2),$PIECE(X,U,3))=VAL
+9 SET ^TMP($JOB,$PIECE(X,U,2),$PIECE(X,U,3),IEN)=""
End DoDot:1
+10 SET PAR=0
FOR
SET PAR=$ORDER(^TMP($JOB,PAR))
if 'PAR
QUIT
Begin DoDot:1
+11 IF '$DATA(^XTV(8989.51,PAR))
WRITE ">> BROKEN PTR TO PARAMETER ("_PAR_")",!
QUIT
+12 SET INST=""
FOR
SET INST=$ORDER(^TMP($JOB,PAR,INST))
if INST=""
QUIT
Begin DoDot:2
+13 DO WAIT
if $DATA(DIRUT)
QUIT
+14 SET VAL=^TMP($JOB,PAR,INST)
+15 WRITE $EXTRACT($PIECE(^XTV(8989.51,PAR,0),U),1,30),?31
+16 WRITE $EXTRACT($$EXT^XPARDD(INST,PAR,"I"),1,20),?52
+17 WRITE $EXTRACT($$EXT^XPARDD(VAL,PAR,"V"),1,28),!
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+18 IF '$DATA(DIRUT)
SET DIR(0)="E"
DO ^DIR
+19 KILL ^TMP($JOB)
+20 QUIT
TMPLT(TLT) ; List values given template
+1 NEW DIC,Y,ALLENT,ALLINST,DTOUT,DUOUT,DIRUT
+2 IF '$GET(TLT)
IF $LENGTH($GET(TLT))
SET TLT=$ORDER(^XTV(8989.52,"B",TLT,0))
+3 IF '$DATA(^XTV(8989.52,+$GET(TLT),0))
NEW TLT
SET DIC=8989.52
SET DIC(0)="AEMQ"
DO ^DIC
if Y<0
QUIT
SET TLT=+Y
+4 DO SELENT^XPAREDT3(.ALLENT,TLT)
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+5 DO SELINST^XPAREDT3(.ALLINST,ALLENT,TLT)
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 DO SHWTLT^XPAREDT3(ALLENT,ALLINST,TLT)
+7 SET DIR(0)="E"
DO ^DIR
+8 QUIT
WAIT ; pause display
+1 SET LN=LN+1
IF LN>(IOSL-4)
SET DIR(0)="E"
DO ^DIR
WRITE !!
if '$DATA(DIRUT)
DO HEADER
SET LN=0
+2 QUIT
ENTNAME(ENT) ; Return TYP: Entity
+1 NEW X,FN
+2 SET FN=+$PIECE(@(U_$PIECE(ENT,";",2)_"0)"),U,2)
SET X=$PIECE(^XTV(8989.518,FN,0),U,2)
+3 SET X=X_": "_$$EXTPTR^XPARDD(+ENT,FN)
+4 QUIT X
+5 ;
+1 WRITE "Parameter",?31,"Instance",?52,"Value",!
+2 WRITE $$REPEAT^XLFSTR("-",IOM-4),!
+3 QUIT
