CIANBACT ;MSC/IND/DKM/PLS - MSC RPC Broker Actions;16-Apr-2013 18:42;PLS
;;1.1;CIA NETWORK COMPONENTS;**001007,001010**;Sep 18, 2007
;;Copyright 2000-2008, Medsphere Systems Corporation
;=================================================================
; Connect action
; CIADATA is returned to client as:
; callback flag^authentication method^server version^case sensitive^context cached
ACTC N X,Y,VOL,UCI,PORT,IP,AUTH
S Y=$$GETUCI,UCI(0)=Y,UCI=$$UP^XLFSTR($G(CIA("UCI"),Y)),VOL=$P(UCI,",",2)
S:'$L(UCI) UCI=Y
S:'$L(VOL) VOL=$P(Y,",",2),$P(UCI,",",2)=VOL
I UCI'=UCI(0),$$ERRCHK(0[$$UCICHECK^%ZOSV(UCI),14,UCI) Q
Q:$$ERRCHK('$L(VOL),11)
S AUTH=$$AUTHMETH(UCI),CIADATA="0^"_AUTH_"^1.1^"_$$GET^XPAR("SYS","XU VC CASE SENSITIVE")_"^1"
Q:$$ERRCHK('$L(AUTH),24,UCI)
I $D(^%ZOSF("ACTJ")) D Q:$$ERRCHK(X'>Y&X,10,Y,X)
.; Y=# active jobs, X=max active jobs
.X ^%ZOSF("ACTJ")
.S X=+$O(^XTV(8989.3,1,4,"B",VOL,0)),X=$S(X:+$P($G(^XTV(8989.3,1,4,X,0)),U,3),1:0)
S PORT=CIA("LP"),X=$$CLIENTIP^CIAUOS,IP=$S(CIAMODE=2:CIAIP,$L(X):X,1:CIA("IP"))
S @("X=$$JOB"_CIAOS)
D ERRCHK('X,12)
Q
; Disconnect action
ACTD D RESET^CIANBRPC()
S CIADATA=1,CIAQUIT=1
Q
; Query action
ACTQ Q:$$ASYCHK^CIANBASY
Q:$$EVTCHK^CIANBEVT
; Ping action
ACTP S DT=$$NOW^XLFDT,CIADATA=$$PARAM^CIANBUTL("CIANB POLLING INTERVAL",1,60)_U_DT,DT=DT\1
Q
; Subscribe action
ACTS S CIADATA=1
Q:$$ERRCHK('$$SUBSCR^CIANBEVT(CIA("EVT"),1),13,CIA("EVT"))
Q
; Unsubscribe action
ACTU S CIADATA=$$SUBSCR^CIANBEVT(CIA("EVT"),0)
Q
; RPC action
ACTR N RPC,RTN,CIAD,XWBWRAP,XWBPTYPE,I
I '$D(CIA("CTX")) S CIA("CTX")=$$GETVAR^CIANBUTL("CTX")
E D SETVAR^CIANBUTL("CTX",CIA("CTX"))
S:CIA("CTX")="" CIA("CTX")=$$GETVAR^CIANBUTL("AID")
S RPC=$$FIND1^DIC(8994,,"QX",$G(CIA("RPC")))
Q:$$ERRCHK('RPC,3)
S I=$G(^XWB(8994,RPC,0)),RTN=$P(I,U,2,3),XWBWRAP=+$P(I,U,8),XWBPTYPE=$P(I,U,4)
Q:$$ERRCHK($S($E($P(RTN,U,2),1,5)="CIANB":0,1:'$$CANRUN(RPC,CIA("CTX"))),4)
Q:$$ERRCHK("03"'[$P(I,U,6),5)
Q:$$ERRCHK(RTN'?.8AN1"^"1.8AN,6)
Q:$$ERRCHK("^1^2^3^4^5^H^"'[(U_XWBPTYPE_U),6)
Q:$$ERRCHK(ARG>40,7,,ARG,40)
I $G(CIA("ASY")) D
.N RD
.S RD="CIANB THREAD RESOURCE #"_$$GETVAR^CIANBUTL("RDEV")
.S CIAD=$$QUEUE^CIAUTSK("TASK^CIANBASY","ASYNC RPC: "_CIA("RPC"),,"RTN^XWBWRAP^XWBPTYPE^ARG^ARG(^CIA(^XWBOS^P*",RD)
.Q:$$ERRCHK(CIAD<1,8)
.S ^XTMP("CIA",CIA("UID"),"T",CIAD)=""
.D REPLY^CIANBLIS(CIAD)
E D
.S:XWBPTYPE=4 CIAD=$$TMPGBL^CIANBRPC("X")
.D STREST^CIANBLIS(1),DORPC,DATAOUT
Q
; Builds the RPC entry code and executes it
DORPC N I,P,XWBAPVER,XQY,CIAQUIT,ALOG,$ET
S RTN=RTN_"(.CIAD",XWBAPVER=$G(CIA("VER")),XQY=$$GETVAR^CIANBUTL("AID0")
S ALOG=$$ISACTIVE^CIANBLOG,ALOG(0)=$S(ALOG:$$LOG^CIANBLOG(ALOG,1,CIA("RPC")),1:0)
F I=1:1:ARG D
.S RTN=RTN_","
.Q:'$D(ARG(I))
.S P="P"_I,RTN=RTN_"."_P
.S:$D(@P)=10 @P=""
.D:ALOG(0) ADD^CIANBLOG(ALOG,ALOG(0),P,1)
S RTN=RTN_")"
D
.N ALOG
.D @RTN
I $$TEST^CIAUOS("BUSARPC") D
.D CIA^BUSARPC(XWBPTYPE,RTN,$G(CIA("RPC")))
I ALOG(0) D
.N VAL,ARY
.S VAL=$C(13)_"Return Data:"_$C(13)
.D ADD^CIANBLOG(ALOG,ALOG(0),"VAL")
.I XWBPTYPE=1 S VAL=$G(CIAD),ARY="VAL"
.E I XWBPTYPE=2 S ARY="CIAD"
.E I XWBPTYPE=3 S ARY="CIAD"
.E I XWBPTYPE=4 S ARY=CIAD
.E I XWBPTYPE=5 S VAL=$G(@CIAD),ARY="VAL"
.E I XWBPTYPE="H" S VAL=CIAD,ARY="VAL"
.E Q
.D ADD^CIANBLOG(ALOG,ALOG(0),ARY)
Q
; Test for error condition
; TEST = If true, setup the error
; ERR = Error code
; Pn = Optional parameters (up to 3)
ERRCHK(TEST,ERR,P1,P2,P3) ;
I TEST,'$G(CIAERR(0)) D
.D GETDLG^CIANBUTL(ERR,.CIAERR,.P1,.P2,.P3)
.S CIAERR(0)=ERR
Q:$Q +$G(CIAERR(0))
Q
; Writes return data to TCP stream
DATAOUT D TCPUSE^CIANBLIS
W $C(0)
I XWBPTYPE=1 W $G(CIAD),! Q
I XWBPTYPE=2 D OUT("CIAD",1) Q
I XWBPTYPE=3 D OUT("CIAD",XWBWRAP) Q
I XWBPTYPE=4 D OUT(CIAD,XWBWRAP) Q
I XWBPTYPE=5 W $G(@CIAD),! Q
I XWBPTYPE="H" D HFSOUT(CIAD,XWBWRAP) Q
Q
; Write array (local or global) to TCP stream
OUT(ARY,EOL) ;
N X,L,K
S K=$E(ARY)'="~"
S:'K ARY=$E(ARY,2,999)
Q:'$L(ARY)
S ARY=$NA(@ARY)
S X=ARY,L=$QL(ARY),EOL=$S($G(EOL):$C(13),1:"")
F S X=$Q(@X) Q:'$L(X) Q:$NA(@X,L)'=ARY W @X,EOL,!
K:K @ARY
Q
; Write contents of HFS to TCP stream
HFSOUT(HFS,EOL) ;
N X
S EOL=$S($G(EOL):$C(13),1:"")
D OPEN^CIAUOS(.HFS,"R")
F Q:$$READ^CIAUOS(.X,HFS) D
.D TCPUSE^CIANBLIS
.W X,EOL,!
D CLOSE^CIAUOS(.HFS),DELETE^CIAUOS(HFS)
Q
; Returns true if RPC can run in current context
CANRUN(RPC,CTX) ;
Q:'$G(DUZ)!'RPC 0
S CTX(0)=$$OPTLKP^CIANBUTL(CTX)
Q:$$ERRCHK('$L(CTX(0)),2,CTX) 0
D:'$G(^XTMP("CIA",CIA("UID"),"C",CTX(0))) BLDCTX(CTX(0))
Q:$$KCHK^XUSRB("XUPROGMODE") 1
Q $D(^XTMP("CIA",CIA("UID"),"C",CTX(0),RPC))
; Build RPC context table
BLDCTX(OPT,CTX) ;
N X
I '$D(CTX) K ^XTMP("CIA",CIA("UID"),"C",OPT) S ^(OPT)=1,CTX=OPT
Q:$D(^XTMP("CIA",CIA("UID"),"C",CTX,0,OPT)) S ^(OPT)=""
Q:$$OPTCHK^CIANBUTL(OPT,"B")
M ^XTMP("CIA",CIA("UID"),"C",CTX)=^DIC(19,OPT,"RPC","B")
F X=0:0 S X=$O(^DIC(19,OPT,10,"B",X)) Q:'X D BLDCTX(X,CTX)
K:CTX=OPT ^XTMP("CIA",CIA("UID"),"C",CTX,0)
Q
; OS-specific job commands
JOB1() I CIAMODE=2 D MODE2 Q 1
J EN^CIANBLIS(PORT,IP,1)[UCI]::15
Q $T
JOB2() I CIAMODE=2 D MODE2 Q 1
J EN^CIANBLIS(PORT,IP,1)[UCI]:100000:15
Q $T
JOB3() I $G(CIA("DBG"))!($G(CIA("VER"))<1.5) J EN^CIANBLIS(PORT,IP,1)[$P(UCI,",")]::15 Q $T
S $P(CIADATA,U)=1
D REPLY^CIANBLIS(CIADATA)
K CIADATA
J EN^CIANBLIS(CIAPORT,CIAIP,2)[$P(UCI,",")]:(:4:CIATDEV:CIATDEV):15
Q $T
; Mode 2 support for MSM and DSM
MODE2 D:UCI'=UCI(0) SETUCI(UCI)
S UCI(0)=UCI
I '$G(CIA("DBG")),$G(CIA("VER"))'<1.5 S $P(CIADATA,U)=1,CIAMODE=1
E S CIAQUIT=1 D REPLY^CIANBLIS(),TCPCLOSE^CIANBLIS,EN^CIANBLIS(PORT,IP,1)
Q
; Return current UCI
GETUCI() N Y
D UCI^%ZOSV
Q Y
; Change UCI
SETUCI(X) D SWAP^%XUCI
Q
; Get authentication method for target UCI
AUTHMETH(UCI) ;
N X,PC
F PC=2,1 D Q:$L(X)
.S X=$$GET^XPAR("ALL","CIANB AUTHENTICATION",$P(UCI,",",1,PC))
Q X
CIANBACT ;MSC/IND/DKM/PLS - MSC RPC Broker Actions;16-Apr-2013 18:42;PLS
+1 ;;1.1;CIA NETWORK COMPONENTS;**001007,001010**;Sep 18, 2007
+2 ;;Copyright 2000-2008, Medsphere Systems Corporation
+3 ;=================================================================
+4 ; Connect action
+5 ; CIADATA is returned to client as:
+6 ; callback flag^authentication method^server version^case sensitive^context cached
ACTC NEW X,Y,VOL,UCI,PORT,IP,AUTH
+1 SET Y=$$GETUCI
SET UCI(0)=Y
SET UCI=$$UP^XLFSTR($GET(CIA("UCI"),Y))
SET VOL=$PIECE(UCI,",",2)
+2 IF '$LENGTH(UCI)
SET UCI=Y
+3 IF '$LENGTH(VOL)
SET VOL=$PIECE(Y,",",2)
SET $PIECE(UCI,",",2)=VOL
+4 IF UCI'=UCI(0)
IF $$ERRCHK(0[$$UCICHECK^%ZOSV(UCI),14,UCI)
QUIT
+5 IF $$ERRCHK('$LENGTH(VOL),11)
QUIT
+6 SET AUTH=$$AUTHMETH(UCI)
SET CIADATA="0^"_AUTH_"^1.1^"_$$GET^XPAR("SYS","XU VC CASE SENSITIVE")_"^1"
+7 IF $$ERRCHK('$LENGTH(AUTH),24,UCI)
QUIT
+8 IF $DATA(^%ZOSF("ACTJ"))
Begin DoDot:1
+9 ; Y=# active jobs, X=max active jobs
+10 XECUTE ^%ZOSF("ACTJ")
+11 SET X=+$ORDER(^XTV(8989.3,1,4,"B",VOL,0))
SET X=$SELECT(X:+$PIECE($GET(^XTV(8989.3,1,4,X,0)),U,3),1:0)
End DoDot:1
IF $$ERRCHK(X'>Y&X,10,Y,X)
QUIT
+12 SET PORT=CIA("LP")
SET X=$$CLIENTIP^CIAUOS
SET IP=$SELECT(CIAMODE=2:CIAIP,$LENGTH(X):X,1:CIA("IP"))
+13 SET @("X=$$JOB"_CIAOS)
+14 DO ERRCHK('X,12)
+15 QUIT
+16 ; Disconnect action
ACTD DO RESET^CIANBRPC()
+1 SET CIADATA=1
SET CIAQUIT=1
+2 QUIT
+3 ; Query action
ACTQ IF $$ASYCHK^CIANBASY
QUIT
+1 IF $$EVTCHK^CIANBEVT
QUIT
+2 ; Ping action
ACTP SET DT=$$NOW^XLFDT
SET CIADATA=$$PARAM^CIANBUTL("CIANB POLLING INTERVAL",1,60)_U_DT
SET DT=DT\1
+1 QUIT
+2 ; Subscribe action
ACTS SET CIADATA=1
+1 IF $$ERRCHK('$$SUBSCR^CIANBEVT(CIA("EVT"),1),13,CIA("EVT"))
QUIT
+2 QUIT
+3 ; Unsubscribe action
ACTU SET CIADATA=$$SUBSCR^CIANBEVT(CIA("EVT"),0)
+1 QUIT
+2 ; RPC action
ACTR NEW RPC,RTN,CIAD,XWBWRAP,XWBPTYPE,I
+1 IF '$DATA(CIA("CTX"))
SET CIA("CTX")=$$GETVAR^CIANBUTL("CTX")
+2 IF '$TEST
DO SETVAR^CIANBUTL("CTX",CIA("CTX"))
+3 IF CIA("CTX")=""
SET CIA("CTX")=$$GETVAR^CIANBUTL("AID")
+4 SET RPC=$$FIND1^DIC(8994,,"QX",$GET(CIA("RPC")))
+5 IF $$ERRCHK('RPC,3)
QUIT
+6 SET I=$GET(^XWB(8994,RPC,0))
SET RTN=$PIECE(I,U,2,3)
SET XWBWRAP=+$PIECE(I,U,8)
SET XWBPTYPE=$PIECE(I,U,4)
+7 IF $$ERRCHK($SELECT($EXTRACT($PIECE(RTN,U,2),1,5)="CIANB"
QUIT
+8 IF $$ERRCHK("03"'[$PIECE(I,U,6),5)
QUIT
+9 IF $$ERRCHK(RTN'?.8AN1"^"1.8AN,6)
QUIT
+10 IF $$ERRCHK("^1^2^3^4^5^H^"'[(U_XWBPTYPE_U),6)
QUIT
+11 IF $$ERRCHK(ARG>40,7,,ARG,40)
QUIT
+12 IF $GET(CIA("ASY"))
Begin DoDot:1
+13 NEW RD
+14 SET RD="CIANB THREAD RESOURCE #"_$$GETVAR^CIANBUTL("RDEV")
+15 SET CIAD=$$QUEUE^CIAUTSK("TASK^CIANBASY","ASYNC RPC: "_CIA("RPC"),,"RTN^XWBWRAP^XWBPTYPE^ARG^ARG(^CIA(^XWBOS^P*",RD)
+16 IF $$ERRCHK(CIAD<1,8)
QUIT
+17 SET ^XTMP("CIA",CIA("UID"),"T",CIAD)=""
+18 DO REPLY^CIANBLIS(CIAD)
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 IF XWBPTYPE=4
SET CIAD=$$TMPGBL^CIANBRPC("X")
+21 DO STREST^CIANBLIS(1)
DO DORPC
DO DATAOUT
End DoDot:1
+22 QUIT
+23 ; Builds the RPC entry code and executes it
DORPC NEW I,P,XWBAPVER,XQY,CIAQUIT,ALOG,$ETRAP
+1 SET RTN=RTN_"(.CIAD"
SET XWBAPVER=$GET(CIA("VER"))
SET XQY=$$GETVAR^CIANBUTL("AID0")
+2 SET ALOG=$$ISACTIVE^CIANBLOG
SET ALOG(0)=$SELECT(ALOG:$$LOG^CIANBLOG(ALOG,1,CIA("RPC")),1:0)
+3 FOR I=1:1:ARG
Begin DoDot:1
+4 SET RTN=RTN_","
+5 IF '$DATA(ARG(I))
QUIT
+6 SET P="P"_I
SET RTN=RTN_"."_P
+7 IF $DATA(@P)=10
SET @P=""
+8 IF ALOG(0)
DO ADD^CIANBLOG(ALOG,ALOG(0),P,1)
End DoDot:1
+9 SET RTN=RTN_")"
+10 Begin DoDot:1
+11 NEW ALOG
+12 DO @RTN
End DoDot:1
+13 IF $$TEST^CIAUOS("BUSARPC")
Begin DoDot:1
+14 DO CIA^BUSARPC(XWBPTYPE,RTN,$GET(CIA("RPC")))
End DoDot:1
+15 IF ALOG(0)
Begin DoDot:1
+16 NEW VAL,ARY
+17 SET VAL=$CHAR(13)_"Return Data:"_$CHAR(13)
+18 DO ADD^CIANBLOG(ALOG,ALOG(0),"VAL")
+19 IF XWBPTYPE=1
SET VAL=$GET(CIAD)
SET ARY="VAL"
+20 IF '$TEST
IF XWBPTYPE=2
SET ARY="CIAD"
+21 IF '$TEST
IF XWBPTYPE=3
SET ARY="CIAD"
+22 IF '$TEST
IF XWBPTYPE=4
SET ARY=CIAD
+23 IF '$TEST
IF XWBPTYPE=5
SET VAL=$GET(@CIAD)
SET ARY="VAL"
+24 IF '$TEST
IF XWBPTYPE="H"
SET VAL=CIAD
SET ARY="VAL"
+25 IF '$TEST
QUIT
+26 DO ADD^CIANBLOG(ALOG,ALOG(0),ARY)
End DoDot:1
+27 QUIT
+28 ; Test for error condition
+29 ; TEST = If true, setup the error
+30 ; ERR = Error code
+31 ; Pn = Optional parameters (up to 3)
ERRCHK(TEST,ERR,P1,P2,P3) ;
+1 IF TEST
IF '$GET(CIAERR(0))
Begin DoDot:1
+2 DO GETDLG^CIANBUTL(ERR,.CIAERR,.P1,.P2,.P3)
+3 SET CIAERR(0)=ERR
End DoDot:1
+4 IF $QUIT
QUIT +$GET(CIAERR(0))
+5 QUIT
+6 ; Writes return data to TCP stream
DATAOUT DO TCPUSE^CIANBLIS
+1 WRITE $CHAR(0)
+2 IF XWBPTYPE=1
WRITE $GET(CIAD),!
QUIT
+3 IF XWBPTYPE=2
DO OUT("CIAD",1)
QUIT
+4 IF XWBPTYPE=3
DO OUT("CIAD",XWBWRAP)
QUIT
+5 IF XWBPTYPE=4
DO OUT(CIAD,XWBWRAP)
QUIT
+6 IF XWBPTYPE=5
WRITE $GET(@CIAD),!
QUIT
+7 IF XWBPTYPE="H"
DO HFSOUT(CIAD,XWBWRAP)
QUIT
+8 QUIT
+9 ; Write array (local or global) to TCP stream
OUT(ARY,EOL) ;
+1 NEW X,L,K
+2 SET K=$EXTRACT(ARY)'="~"
+3 IF 'K
SET ARY=$EXTRACT(ARY,2,999)
+4 IF '$LENGTH(ARY)
QUIT
+5 SET ARY=$NAME(@ARY)
+6 SET X=ARY
SET L=$QLENGTH(ARY)
SET EOL=$SELECT($GET(EOL):$CHAR(13),1:"")
+7 FOR
SET X=$QUERY(@X)
IF '$LENGTH(X)
QUIT
IF $NAME(@X,L)'=ARY
QUIT
WRITE @X,EOL,!
+8 IF K
KILL @ARY
+9 QUIT
+10 ; Write contents of HFS to TCP stream
HFSOUT(HFS,EOL) ;
+1 NEW X
+2 SET EOL=$SELECT($GET(EOL):$CHAR(13),1:"")
+3 DO OPEN^CIAUOS(.HFS,"R")
+4 FOR
IF $$READ^CIAUOS(.X,HFS)
QUIT
Begin DoDot:1
+5 DO TCPUSE^CIANBLIS
+6 WRITE X,EOL,!
End DoDot:1
+7 DO CLOSE^CIAUOS(.HFS)
DO DELETE^CIAUOS(HFS)
+8 QUIT
+9 ; Returns true if RPC can run in current context
CANRUN(RPC,CTX) ;
+1 IF '$GET(DUZ)!'RPC
QUIT 0
+2 SET CTX(0)=$$OPTLKP^CIANBUTL(CTX)
+3 IF $$ERRCHK('$LENGTH(CTX(0)),2,CTX)
QUIT 0
+4 IF '$GET(^XTMP("CIA",CIA("UID"),"C",CTX(0)))
DO BLDCTX(CTX(0))
+5 IF $$KCHK^XUSRB("XUPROGMODE")
QUIT 1
+6 QUIT $DATA(^XTMP("CIA",CIA("UID"),"C",CTX(0),RPC))
+7 ; Build RPC context table
BLDCTX(OPT,CTX) ;
+1 NEW X
+2 IF '$DATA(CTX)
KILL ^XTMP("CIA",CIA("UID"),"C",OPT)
SET ^(OPT)=1
SET CTX=OPT
+3 IF $DATA(^XTMP("CIA",CIA("UID"),"C",CTX,0,OPT))
QUIT
SET ^(OPT)=""
+4 IF $$OPTCHK^CIANBUTL(OPT,"B")
QUIT
+5 MERGE ^XTMP("CIA",CIA("UID"),"C",CTX)=^DIC(19,OPT,"RPC","B")
+6 FOR X=0:0
SET X=$ORDER(^DIC(19,OPT,10,"B",X))
IF 'X
QUIT
DO BLDCTX(X,CTX)
+7 IF CTX=OPT
KILL ^XTMP("CIA",CIA("UID"),"C",CTX,0)
+8 QUIT
+9 ; OS-specific job commands
JOB1() IF CIAMODE=2
DO MODE2
QUIT 1
+1 JOB EN^CIANBLIS(PORT,IP,1)[UCI]::15
+2 QUIT $TEST
JOB2() IF CIAMODE=2
DO MODE2
QUIT 1
+1 JOB EN^CIANBLIS(PORT,IP,1)[UCI]:100000:15
+2 QUIT $TEST
JOB3() IF $GET(CIA("DBG"))!($GET(CIA("VER"))<1.5)
JOB EN^CIANBLIS(PORT,IP,1)[$PIECE(UCI,",")]::15
QUIT $TEST
+1 SET $PIECE(CIADATA,U)=1
+2 DO REPLY^CIANBLIS(CIADATA)
+3 KILL CIADATA
+4 JOB EN^CIANBLIS(CIAPORT,CIAIP,2)[$PIECE(UCI,",")]:(:4:CIATDEV:CIATDEV):15
+5 QUIT $TEST
+6 ; Mode 2 support for MSM and DSM
MODE2 IF UCI'=UCI(0)
DO SETUCI(UCI)
+1 SET UCI(0)=UCI
+2 IF '$GET(CIA("DBG"))
IF $GET(CIA("VER"))'<1.5
SET $PIECE(CIADATA,U)=1
SET CIAMODE=1
+3 IF '$TEST
SET CIAQUIT=1
DO REPLY^CIANBLIS()
DO TCPCLOSE^CIANBLIS
DO EN^CIANBLIS(PORT,IP,1)
+4 QUIT
+5 ; Return current UCI
GETUCI() NEW Y
+1 DO UCI^%ZOSV
+2 QUIT Y
+3 ; Change UCI
SETUCI(X) DO SWAP^%XUCI
+1 QUIT
+2 ; Get authentication method for target UCI
AUTHMETH(UCI) ;
+1 NEW X,PC
+2 FOR PC=2,1
Begin DoDot:1
+3 SET X=$$GET^XPAR("ALL","CIANB AUTHENTICATION",$PIECE(UCI,",",1,PC))
End DoDot:1
IF $LENGTH(X)
QUIT
+4 QUIT X
