XUPARAM.m

XUPARAM ;SF/RWF - Lookup parameter substitute, KSP values ;03/26/2003  11:56 [ 07/29/2004   9:01 AM ]

 ;;8.0;KERNEL;**65,115,224**;Jul 10, 1995

 Q

GET(%X,STYLE) ;Get substitute value

 ;Style, N will return call name as default

 ;       V will return null as default

 ;otherwize will return zero as default

 N %1,%2,%Y S STYLE=$G(STYLE),%Y=$S(STYLE="N":%X,STYLE="V":"",1:0)

 S %1=$$LKUP(%X) I %1'>0 Q %Y

 S %2=$G(^XTV(8989.2,%1,0))

 I $P(%2,"^",4)]"" Q $P(%2,"^",4)

 I $P(%2,"^",3)]"" Q $P(%2,"^",3)

 Q %Y

SET(%X,VALUE,DEF) ;Set parameter value, default

 N %1

 S %1=$$LKUP(%X,"A") Q:%1'>0

 Q:'$D(VALUE)

 S $P(^XTV(8989.2,%1,0),"^",4)=VALUE S:$G(DEF)]"" $P(^XTV(8989.2,%1,0),"^",3)=DEF

 Q

LKUP(X,ACTION) ;

 N E

 S E=$O(^XTV(8989.2,"B",X,0)) I E>0 Q E

 I $G(ACTION)'["A" Q -1

 N DA,DIC,DLAYGO,Y

 S DIC="^XTV(8989.2,",DIC(0)="ML",DLAYGO=8989.2 D FILE^DICN

 Q +Y

 ;

BAT() Q $P($G(^XTV(8989.3,1,"XWB"),180),U) ;Broker Activity timeout

 ;

KSP(NAME) ;To return data from KSP file.

 N NM S NM=$P($G(NAME)," ")

 Q:'$L(NM) "" ;No parameter value

 Q:$T(@NM)="" ""  G @NM

SPOOL Q $P($G(^XTV(8989.3,1,"SPL")),"^",$S(NAME["LINE":1,NAME["DOC":2,NAME["LIFE":3,1:1))

WHERE Q $P($G(^DIC(4.2,(+^XTV(8989.3,1,0)),0)),"^")

INST Q $P($G(^XTV(8989.3,1,"XUS")),U,17)

LIFETIME Q $P($G(^XTV(8989.3,1,"XUS")),U,15) ;Verify code lifetime

XUPARAM   ;SF/RWF - Lookup parameter substitute, KSP values ;03/26/2003  11:56 [ 07/29/2004   9:01 AM ]

 +1       ;;8.0;KERNEL;**65,115,224**;Jul 10, 1995

 +2        QUIT 

GET(%X,STYLE) ;Get substitute value

 +1       ;Style, N will return call name as default

 +2       ;       V will return null as default

 +3       ;otherwize will return zero as default

 +4        NEW %1,%2,%Y

           SET STYLE=$GET(STYLE)

           SET %Y=$SELECT(STYLE="N":%X,STYLE="V":"",1:0)

 +5        SET %1=$$LKUP(%X)

           IF %1'>0

               QUIT %Y

 +6        SET %2=$GET(^XTV(8989.2,%1,0))

 +7        IF $PIECE(%2,"^",4)]""

               QUIT $PIECE(%2,"^",4)

 +8        IF $PIECE(%2,"^",3)]""

               QUIT $PIECE(%2,"^",3)

 +9        QUIT %Y

SET(%X,VALUE,DEF) ;Set parameter value, default

 +1        NEW %1

 +2        SET %1=$$LKUP(%X,"A")

           IF %1'>0

               QUIT 

 +3        IF '$DATA(VALUE)

               QUIT 

 +4        SET $PIECE(^XTV(8989.2,%1,0),"^",4)=VALUE

           IF $GET(DEF)]""

               SET $PIECE(^XTV(8989.2,%1,0),"^",3)=DEF

 +5        QUIT 

LKUP(X,ACTION) ;

 +1        NEW E

 +2        SET E=$ORDER(^XTV(8989.2,"B",X,0))

           IF E>0

               QUIT E

 +3        IF $GET(ACTION)'["A"

               QUIT -1

 +4        NEW DA,DIC,DLAYGO,Y

 +5        SET DIC="^XTV(8989.2,"

           SET DIC(0)="ML"

           SET DLAYGO=8989.2

           DO FILE^DICN

 +6        QUIT +Y

 +7       ;

BAT()     ;Broker Activity timeout

           QUIT $PIECE($GET(^XTV(8989.3,1,"XWB"),180),U)

 +1       ;

KSP(NAME) ;To return data from KSP file.

 +1        NEW NM

           SET NM=$PIECE($GET(NAME)," ")

 +2       ;No parameter value

           IF '$LENGTH(NM)

               QUIT ""

 +3        IF $TEXT(@NM)=""

               QUIT ""

           GOTO @NM

SPOOL      QUIT $PIECE($GET(^XTV(8989.3,1,"SPL")),"^",$SELECT(NAME["LINE":1,NAME["DOC":2,NAME["LIFE":3,1:1))

WHERE      QUIT $PIECE($GET(^DIC(4.2,(+^XTV(8989.3,1,0)),0)),"^")

INST       QUIT $PIECE($GET(^XTV(8989.3,1,"XUS")),U,17)

LIFETIME  ;Verify code lifetime

           QUIT $PIECE($GET(^XTV(8989.3,1,"XUS")),U,15)