CIAVMRPC.m

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))