CIAVMRPC ;MSC/IND/DKM - Miscellaneous RPC calls ;22-Oct-2007 13:08;DKM
;;1.1V2;VUECENTRIC FRAMEWORK;**1**;Mar 20, 2007
;;Copyright 2000-2006, Medsphere Systems Corporation
;=================================================================
; RPC: Initialize a session
INIT(DATA,CIAVER) ;
N PAR,MINVER,X
S MINVER="1.4"
I $$VERCMP(CIAVER,MINVER,$L(MINVER,"."))<0 S DATA(0)="-2^Client version ("_CIAVER_") is not compatible with server version ("_MINVER_")." Q
S DATA(0)=0
F X=0:1 S PAR=$P($T(INITPAR+X),";;",2) Q:'$L(PAR) D
.S DATA(X+1)=$$PARAM($P(PAR,U),$P(PAR,U,2),$P(PAR,U,3))
Q
; Initialization parameters to return to caller (do not change order)
; Format is param name^low limit^high limit
INITPAR ;;CIAVM DISABLE CCOW^0^1
;;
; Retrieve a package parameter value
PARAM(PAR,MIN,MAX) ;
S VAL=+$$GET^XPAR("ALL",PAR)
S:VAL<MIN VAL=MIN
S:VAL>MAX VAL=MAX
Q VAL
; RPC: Get/set DISV entry for selected file/IEN
; If IEN is specified, entry is set
; Returned as IEN^.01 internal value
DISV(DATA,FILE,IEN) ;
S FILE=$$ROOT^DILFD(+FILE)
I FILE="" S DATA=0 Q
S:$G(IEN) ^DISV(DUZ,FILE)=IEN
S DATA=+$G(^DISV(DUZ,FILE))
S:DATA $P(DATA,U,2)=$P($G(@(FILE_DATA_",0)")),U)
Q
; RPC: Return version of package
VERSION(DATA,PKG) ;
S DATA=$$VERSION^XPDUTL(PKG)
Q
; RPC: Return true if patch installed
PATCH(DATA,PATCH) ;
S DATA=$$PATCH^XPDUTL(PATCH)
Q
; RPC: Returns value for named parameter
GETPAR(DATA,PARAM,ENT,INST,FMT,USR) ;
N X
S ENT=$$ENT(PARAM,.ENT,.USR),DATA=$S($L(ENT):$$GET^XPAR(ENT,PARAM,.INST,.FMT),1:"")
Q
; RPC: Get multivalued parameter values
GETPARLI(DATA,PARAM,ENT,FMT,USR) ;
N TMP,X
D GETLST^XPAR(.TMP,$$ENT(PARAM,.ENT,.USR),PARAM,.FMT,.ERR)
I $G(ERR) K TMP S TMP=ERR
E S TMP=""
S DATA=$$TMPGBL
M @DATA=TMP
Q
; RPC: Get WP parameter value
GETPARWP(DATA,PARAM,ENT,INST,USR) ;
N TMP,X
D GETWP^XPAR(.TMP,$$ENT(PARAM,.ENT,.USR),PARAM,.INST,.ERR)
I $G(ERR) K TMP S TMP=ERR
E S TMP=""
S DATA=$$TMPGBL
M @DATA=TMP
Q
; Return entity list (if ENT not specified)
ENT(PAR,ENT,USR) ;EP
N I,X,Y,Z
Q:$L($G(ENT)) ENT
I $L(PAR),PAR'=+PAR S PAR=$O(^XTV(8989.51,"B",PAR,0))
Q:'PAR ""
S X="",I=0,USR=$G(USR,DUZ)
F S I=+$O(^XTV(8989.51,PAR,30,"B",I)) Q:'I S Y=$O(^(I,0)) D:Y
.S Y=$P($G(^XTV(8989.518,+$P($G(^XTV(8989.51,PAR,30,Y,0)),U,2),0)),U,2)
.Q:'$L(Y)
.I "DIV^SYS^PKG"[Y S X=X_U_Y Q
.I Y="USR" S X=X_U_"USR.`"_USR Q
.I Y="SRV" S Z=+$G(^VA(200,USR,5)) S:Z X=X_U_"SRV.`"_Z Q
.I Y="OTL" Q ; OE/RR TEAM
.I Y="TEA" Q ; TEAM
.I Y="CLS" D Q
..S Z=0
..F S Z=$O(^USR(8930.3,"AUC",USR,Z)) Q:'Z D CLS(Z)
.I Y="LOC",$G(CIA("UID")) D Q
..S Z=+$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
..S:Z X=X_U_"LOC.`"_Z
Q $E(X,2,$L(X))
; Append user class memberships to entity list
CLS(Z) N Y
S X=X_U_"CLS.`"_Z,Y=0
F S Y=$O(^USR(8930,"AD",Z,Y)) Q:'Y D CLS(Y)
Q
; RPC: Changes value for named parameter
SETPAR(DATA,PARAM,VAL,ENT,INST) ;
D EN^XPAR($G(ENT,"PKG"),PARAM,$G(INST,1),VAL,.DATA)
Q
; RPC: Get stored variable(s)
GETVAR(DATA,LIST,NMSP) ;
N CNT
S:$L($G(LIST)) LIST(-99)=LIST
S LIST="",CNT=0
F S LIST=$O(LIST(LIST)) Q:'$L(LIST) D
.S CNT=CNT+1,DATA(CNT)=LIST(LIST)_"="_$$GETVAR^CIANBUTL(LIST(LIST),,.NMSP)
Q
; RPC: Set stored variable(s)
SETVAR(DATA,LIST,NMSP,RESET) ;
S:$L($G(LIST)) LIST(-99)=LIST
S LIST="",DATA=0
D:$G(RESET) CLRVAR^CIANBUTL(.NMSP)
F S LIST=$O(LIST(LIST)) Q:'$L(LIST) D
.S DATA=DATA+1
.D SETVAR^CIANBUTL($P(LIST(LIST),"="),$P(LIST(LIST),"=",2,9999),.NMSP)
Q
; RPC: Get .01 field values from a file
GETIDX(DATA,FN,FLG) ;
N X,I,Z
S DATA=$$TMPGBL,X=0,FN=$$ROOT^DILFD(FN,,1),I=0,FLG=+$G(FLG)
I $L(FN) F S X=$O(@FN@(X)) Q:'X D
.S Z=$P($G(@FN@(X,0)),U)
.S:$L(Z) I=I+1,@DATA@(I)=$S(FLG:Z,1:X_U_Z)
Q
; RPC: Convert date input to FM format
STRTODAT(DATA,VAL,FMT) ;
N %DT,X,Y
I VAL'["@",VAL[" " S VAL=$TR(VAL," ","@")
I VAL["@",$TR($P(VAL,"@",2),":0")="" S $P(VAL,"@",2)="00:00:01"
S %DT=$G(FMT,"TS"),X=VAL
D ^%DT
S DATA=$S(Y>0:Y,1:"")
Q
; Compare version # VER1 with VER2
; Returns -1 if < 0 if =; 1 if >
VERCMP(VER1,VER2,PC) ;EP
N X,Y,V1,V2
S:'$G(PC) PC=4
S Y=0
F X=1:1:PC D Q:Y
.S V1=+$P(VER1,".",X),V2=+$P(VER2,".",X)
.S:V1'=V2 Y=$S(V1>V2:1,1:-1)
Q Y
; Get temp global reference
TMPGBL(X) ;EP
K ^TMP("CIAVMRPC"_$G(X),$J) Q $NA(^($J))
CIAVMRPC ;MSC/IND/DKM - Miscellaneous RPC calls ;22-Oct-2007 13:08;DKM
+1 ;;1.1V2;VUECENTRIC FRAMEWORK;**1**;Mar 20, 2007
+2 ;;Copyright 2000-2006, Medsphere Systems Corporation
+3 ;=================================================================
+4 ; RPC: Initialize a session
INIT(DATA,CIAVER) ;
+1 NEW PAR,MINVER,X
+2 SET MINVER="1.4"
+3 IF $$VERCMP(CIAVER,MINVER,$LENGTH(MINVER,"."))<0
SET DATA(0)="-2^Client version ("_CIAVER_") is not compatible with server version ("_MINVER_")."
QUIT
+4 SET DATA(0)=0
+5 FOR X=0:1
SET PAR=$PIECE($TEXT(INITPAR+X),";;",2)
IF '$LENGTH(PAR)
QUIT
Begin DoDot:1
+6 SET DATA(X+1)=$$PARAM($PIECE(PAR,U),$PIECE(PAR,U,2),$PIECE(PAR,U,3))
End DoDot:1
+7 QUIT
+8 ; Initialization parameters to return to caller (do not change order)
+9 ; Format is param name^low limit^high limit
INITPAR ;;CIAVM DISABLE CCOW^0^1
+1 ;;
+2 ; Retrieve a package parameter value
PARAM(PAR,MIN,MAX) ;
+1 SET VAL=+$$GET^XPAR("ALL",PAR)
+2 IF VAL<MIN
SET VAL=MIN
+3 IF VAL>MAX
SET VAL=MAX
+4 QUIT VAL
+5 ; RPC: Get/set DISV entry for selected file/IEN
+6 ; If IEN is specified, entry is set
+7 ; Returned as IEN^.01 internal value
DISV(DATA,FILE,IEN) ;
+1 SET FILE=$$ROOT^DILFD(+FILE)
+2 IF FILE=""
SET DATA=0
QUIT
+3 IF $GET(IEN)
SET ^DISV(DUZ,FILE)=IEN
+4 SET DATA=+$GET(^DISV(DUZ,FILE))
+5 IF DATA
SET $PIECE(DATA,U,2)=$PIECE($GET(@(FILE_DATA_",0)")),U)
+6 QUIT
+7 ; RPC: Return version of package
VERSION(DATA,PKG) ;
+1 SET DATA=$$VERSION^XPDUTL(PKG)
+2 QUIT
+3 ; RPC: Return true if patch installed
PATCH(DATA,PATCH) ;
+1 SET DATA=$$PATCH^XPDUTL(PATCH)
+2 QUIT
+3 ; RPC: Returns value for named parameter
GETPAR(DATA,PARAM,ENT,INST,FMT,USR) ;
+1 NEW X
+2 SET ENT=$$ENT(PARAM,.ENT,.USR)
SET DATA=$SELECT($LENGTH(ENT):$$GET^XPAR(ENT,PARAM,.INST,.FMT),1:"")
+3 QUIT
+4 ; RPC: Get multivalued parameter values
GETPARLI(DATA,PARAM,ENT,FMT,USR) ;
+1 NEW TMP,X
+2 DO GETLST^XPAR(.TMP,$$ENT(PARAM,.ENT,.USR),PARAM,.FMT,.ERR)
+3 IF $GET(ERR)
KILL TMP
SET TMP=ERR
+4 IF '$TEST
SET TMP=""
+5 SET DATA=$$TMPGBL
+6 MERGE @DATA=TMP
+7 QUIT
+8 ; RPC: Get WP parameter value
GETPARWP(DATA,PARAM,ENT,INST,USR) ;
+1 NEW TMP,X
+2 DO GETWP^XPAR(.TMP,$$ENT(PARAM,.ENT,.USR),PARAM,.INST,.ERR)
+3 IF $GET(ERR)
KILL TMP
SET TMP=ERR
+4 IF '$TEST
SET TMP=""
+5 SET DATA=$$TMPGBL
+6 MERGE @DATA=TMP
+7 QUIT
+8 ; Return entity list (if ENT not specified)
ENT(PAR,ENT,USR) ;EP
+1 NEW I,X,Y,Z
+2 IF $LENGTH($GET(ENT))
QUIT ENT
+3 IF $LENGTH(PAR)
IF PAR'=+PAR
SET PAR=$ORDER(^XTV(8989.51,"B",PAR,0))
+4 IF 'PAR
QUIT ""
+5 SET X=""
SET I=0
SET USR=$GET(USR,DUZ)
+6 FOR
SET I=+$ORDER(^XTV(8989.51,PAR,30,"B",I))
IF 'I
QUIT
SET Y=$ORDER(^(I,0))
IF Y
Begin DoDot:1
+7 SET Y=$PIECE($GET(^XTV(8989.518,+$PIECE($GET(^XTV(8989.51,PAR,30,Y,0)),U,2),0)),U,2)
+8 IF '$LENGTH(Y)
QUIT
+9 IF "DIV^SYS^PKG"[Y
SET X=X_U_Y
QUIT
+10 IF Y="USR"
SET X=X_U_"USR.`"_USR
QUIT
+11 IF Y="SRV"
SET Z=+$GET(^VA(200,USR,5))
IF Z
SET X=X_U_"SRV.`"_Z
QUIT
+12 ; OE/RR TEAM
IF Y="OTL"
QUIT
+13 ; TEAM
IF Y="TEA"
QUIT
+14 IF Y="CLS"
Begin DoDot:2
+15 SET Z=0
+16 FOR
SET Z=$ORDER(^USR(8930.3,"AUC",USR,Z))
IF 'Z
QUIT
DO CLS(Z)
End DoDot:2
QUIT
+17 IF Y="LOC"
IF $GET(CIA("UID"))
Begin DoDot:2
+18 SET Z=+$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+19 IF Z
SET X=X_U_"LOC.`"_Z
End DoDot:2
QUIT
End DoDot:1
+20 QUIT $EXTRACT(X,2,$LENGTH(X))
+21 ; Append user class memberships to entity list
CLS(Z) NEW Y
+1 SET X=X_U_"CLS.`"_Z
SET Y=0
+2 FOR
SET Y=$ORDER(^USR(8930,"AD",Z,Y))
IF 'Y
QUIT
DO CLS(Y)
+3 QUIT
+4 ; RPC: Changes value for named parameter
SETPAR(DATA,PARAM,VAL,ENT,INST) ;
+1 DO EN^XPAR($GET(ENT,"PKG"),PARAM,$GET(INST,1),VAL,.DATA)
+2 QUIT
+3 ; RPC: Get stored variable(s)
GETVAR(DATA,LIST,NMSP) ;
+1 NEW CNT
+2 IF $LENGTH($GET(LIST))
SET LIST(-99)=LIST
+3 SET LIST=""
SET CNT=0
+4 FOR
SET LIST=$ORDER(LIST(LIST))
IF '$LENGTH(LIST)
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
SET DATA(CNT)=LIST(LIST)_"="_$$GETVAR^CIANBUTL(LIST(LIST),,.NMSP)
End DoDot:1
+6 QUIT
+7 ; RPC: Set stored variable(s)
SETVAR(DATA,LIST,NMSP,RESET) ;
+1 IF $LENGTH($GET(LIST))
SET LIST(-99)=LIST
+2 SET LIST=""
SET DATA=0
+3 IF $GET(RESET)
DO CLRVAR^CIANBUTL(.NMSP)
+4 FOR
SET LIST=$ORDER(LIST(LIST))
IF '$LENGTH(LIST)
QUIT
Begin DoDot:1
+5 SET DATA=DATA+1
+6 DO SETVAR^CIANBUTL($PIECE(LIST(LIST),"="),$PIECE(LIST(LIST),"=",2,9999),.NMSP)
End DoDot:1
+7 QUIT
+8 ; RPC: Get .01 field values from a file
GETIDX(DATA,FN,FLG) ;
+1 NEW X,I,Z
+2 SET DATA=$$TMPGBL
SET X=0
SET FN=$$ROOT^DILFD(FN,,1)
SET I=0
SET FLG=+$GET(FLG)
+3 IF $LENGTH(FN)
FOR
SET X=$ORDER(@FN@(X))
IF 'X
QUIT
Begin DoDot:1
+4 SET Z=$PIECE($GET(@FN@(X,0)),U)
+5 IF $LENGTH(Z)
SET I=I+1
SET @DATA@(I)=$SELECT(FLG:Z,1:X_U_Z)
End DoDot:1
+6 QUIT
+7 ; RPC: Convert date input to FM format
STRTODAT(DATA,VAL,FMT) ;
+1 NEW %DT,X,Y
+2 IF VAL'["@"
IF VAL[" "
SET VAL=$TRANSLATE(VAL," ","@")
+3 IF VAL["@"
IF $TRANSLATE($PIECE(VAL,"@",2),":0")=""
SET $PIECE(VAL,"@",2)="00:00:01"
+4 SET %DT=$GET(FMT,"TS")
SET X=VAL
+5 DO ^%DT
+6 SET DATA=$SELECT(Y>0:Y,1:"")
+7 QUIT
+8 ; Compare version # VER1 with VER2
+9 ; Returns -1 if < 0 if =; 1 if >
VERCMP(VER1,VER2,PC) ;EP
+1 NEW X,Y,V1,V2
+2 IF '$GET(PC)
SET PC=4
+3 SET Y=0
+4 FOR X=1:1:PC
Begin DoDot:1
+5 SET V1=+$PIECE(VER1,".",X)
SET V2=+$PIECE(VER2,".",X)
+6 IF V1'=V2
SET Y=$SELECT(V1>V2:1,1:-1)
End DoDot:1
IF Y
QUIT
+7 QUIT Y
+8 ; Get temp global reference
TMPGBL(X) ;EP
+1 KILL ^TMP("CIAVMRPC"_$GET(X),$JOB)
QUIT $NAME(^($JOB))