XUPARAM ;SF/RWF - Lookup parameter substitute, KSP values ;03/26/2003 11:56
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUPARAM 1321 printed Oct 16, 2024@18:12:18 Page 2
XUPARAM ;SF/RWF - Lookup parameter substitute, KSP values ;03/26/2003 11:56
+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)
