XPARLIST.m

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

 ;

HEADER ;

 W "Parameter",?31,"Instance",?52,"Value",!

 W $$REPEAT^XLFSTR("-",IOM-4),!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XPARLIST   2662     printed  Feb 19, 2025@00:06:50                                                                                                                                                                                                    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       ;

HEADER    ;

 +1        WRITE "Parameter",?31,"Instance",?52,"Value",!

 +2        WRITE $$REPEAT^XLFSTR("-",IOM-4),!

 +3        QUIT