BTPWTIUT ;VNGT/HS/ALA-TIU Utilities ; 10 Dec 2009 9:41 AM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
;
BL(DATA,TMPIEN) ; EP - BTPW GET TIU TEMPL BOILER
NEW UID,II,TIUY,TEXT,NTEXT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWTIBLR",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T01024REPORT_TEXT"_$C(30)
D GETBOIL^TIUSRVT(.TIUY,TMPIEN)
S N=""
F S N=$O(@TIUY@(N)) Q:N="" D
. S TEXT=@TIUY@(N),NTEXT=$G(@TIUY@(N+1))
. I NTEXT["}",NTEXT'["{" S TEXT=TEXT_NTEXT,N=N+1
. S II=II+1,@DATA@(II)=TEXT_$C(10)
;
K @TIUY
;
; Check for subtemplate items boilerplate
NEW TITM,SBTIEN,N,TEXT,NTEXT
S TITM=0
F S TITM=$O(^TIU(8927,TMPIEN,10,TITM)) Q:'TITM D
. S SBTIEN=$P(^TIU(8927,TMPIEN,10,TITM,0),"^",2)
. D GETBOIL^TIUSRVT(.TIUY,SBTIEN)
. S N=""
. F S N=$O(@TIUY@(N)) Q:N="" D
.. S TEXT=@TIUY@(N),NTEXT=$G(@TIUY@(N+1))
.. I NTEXT["}",NTEXT'["{" S TEXT=TEXT_NTEXT,N=N+1
.. S II=II+1,@DATA@(II)=TEXT_$C(10)
.. K @TIUY
;
S @DATA@(II)=@DATA@(II)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
K @TIUY
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
IT(DATA,TMPIEN) ; EP - BTPW GET TIU TEMPL ITEMS
NEW UID,II,TIUY
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWTIITM",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00030OBJECT^I00010OBJ_IEN^I00010LINE"_$C(30)
D GETBOIL^TIUSRVT(.TIUY,TMPIEN)
;S N=""
;F S N=$O(@TIUY@(N)) Q:N="" S II=II+1,@DATA@(II)=@TIUY@(N)_$C(10)
D GTIT(.TIUY)
K @TIUY
; Check for sub template items
NEW TITM,SBTIEN
S TITM=0
F S TITM=$O(^TIU(8927,TMPIEN,10,TITM)) Q:'TITM D
. S SBTIEN=$P(^TIU(8927,TMPIEN,10,TITM,0),"^",2)
. D GETBOIL^TIUSRVT(.TIUY,SBTIEN)
. ;S N=""
. ;F S N=$O(@TIUY@(N)) Q:N="" S II=II+1,@DATA@(II)=@TIUY@(N)_$C(10)
. D GTIT(.TIUY)
. K @TIUY
S II=II+1,@DATA@(II)=$C(31)
K @TIUY
Q
;
OBJ(DATA,OBIEN) ;EP - BTPW GET TIU OBJECT DEF
NEW UID,II,TIUY,TY,DTY,ITEMS,BJ,TXT,HDR,LENG,DEFTXT,DEFINDX,REQ,SEPL,MAX,INDENT
NEW PAD,MINV,MAXV,INCR,URL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWTIOBJ",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="I00010OBJ_IEN^T00030TYPE^T00030DATE_TYPE^T00006LENGTH^T00075DEFAULT_TEXT^T00005DEFINDX^T00003REQ^"
S HDR=HDR_"T00003SEP_LINE^T00003MAX_LEN^T00002INDENT^T00002PAD^T00004MIN_VAL^T00004MAX_VAL^T00003INCREMENT^"
S HDR=HDR_"T00240URL^T01024ITEMS"
S @DATA@(II)=HDR_$C(30)
D LOADIEN^TIUSRVF(.TIUY,OBIEN)
S BJ=1
; Get definition values
S TY=$P(TIUY(BJ),U,2),LENG=$P(TIUY(BJ),U,4),DEFTXT=$P(TIUY(BJ),U,5),DEFINDX=$P(TIUY(BJ),U,7)
S REQ=$$STC^BQIUL2(8927.1,.08,$P(TIUY(BJ),U,8)),SEPL=$$STC^BQIUL2(8927.1,.09,$P(TIUY(BJ),U,9))
S MAX=$P(TIUY(BJ),U,10),INDENT=$P(TIUY(BJ),U,11),PAD=$P(TIUY(BJ),U,12),MINV=$P(TIUY(BJ),U,13)
S MAXV=$P(TIUY(BJ),U,14),INCR=$P(TIUY(BJ),U,15),URL=$G(^TIU(8927.1,OBIEN,3))
I TY="D" S DTY=$P(TIUY(BJ),U,16),DTY=$$STC^BQIUL2(8927.1,.16,TY)
S TY=$$STC^BQIUL2(8927.1,.02,TY)
; Get items
S ITEMS=""
F S BJ=$O(TIUY(BJ)) Q:BJ="" D
. I $P(TIUY(BJ),U,1)="I" S TXT=$P(TIUY(BJ),U,2),ITEMS=ITEMS_TXT_$C(29)
S ITEMS=$$TKO^BQIUL1(ITEMS,$C(29))
S II=II+1,@DATA@(II)=OBIEN_U_TY_U_$G(DTY)_U_LENG_U_DEFTXT_U_DEFINDX_U_REQ_U_SEPL_U_MAX_U_INDENT_U_PAD_U_MINV_U_MAXV_U_INCR_U_URL_U_ITEMS_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
GTIT(TIUY) ; Get items from boilerplate
NEW BI,BJ,IEN,VAL
K TIUX
S BI=0,BJ=0
F S BI=$O(@TIUY@(BI)) Q:BI="" D
. NEW VALUE
. S VALUE=@TIUY@(BI)
. I VALUE["{FLD:" D
.. NEW X,XLEN,VAR
.. S X=VALUE,XLEN=$L(X)
.. S X=$$DOLMLINE^TIUSRVF1(X)
.. ; If the length of the updated line is NOT less than the original
.. ; line length, then it should have translated okay
.. I $L(X)'<XLEN S VALUE=X Q
.. S X=VALUE
.. NEW I,J
.. F S I=$F(X,"{FLD:") Q:'I D
... S J=$F(X,"}",I)
... I J>0 S NAME=$E(X,I,J-2)
... I J=0,X["{" S X=X_@TIUY@(BI+1) Q
... I J=0,X'["{" S NAME="",J=I Q
... S IEN=$O(^TIU(8927.1,"B",NAME,""))
... S VAL="{FLD:"_NAME_"}"
... S BJ=BJ+1,@DATA@(BJ)=VAL_U_IEN_U_BI_$C(30),II=BJ
... S X=$P(X,VAL,2)
Q
;
DEL(DATA,TIUDA) ;EP -- BTPW DELETE TIU DOCUMENT
NEW UID,II,ERROR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWTIDEL",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S II=0,@DATA@(II)="I00010RESULT^T00080MESSAGE"_$C(30)
D DELETE^TIUSRVP(.ERROR,TIUDA,"")
I 'ERROR S II=II+1,@DATA@(II)="1^"_$C(30) G DONE
S II=II+1,@DATA@(II)="-1^"_$P(ERROR,"^",2)_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
SIGN(DATA,TIUDA,SIGN) ;EP -- BTPW SIGN TIU DOCUMENT
NEW UID,II,RESULT,SIG,SUPRESS,ERROR,TIUX
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWTISIG",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S II=0,@DATA@(II)="I00010RESULT^T00080MESSAGE"_$C(30)
S SIGN=$$DECRYP^XUSRB1(SIGN)
D SIGCHK^BMXRPC3(.RESULT,SIGN)
I RESULT=0 S RESULT=-1,MSG="Signature not validated" S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30) G DONE
I $E(SIGN,1)'=" " S SIGN=" "_SIGN_" "
D VALIDSIG^ORWU(.SIG,SIGN)
S SUPRESS=0 I SIG S SUPRESS=1
I $D(^TIU(8925,TIUDA,"TEMP")),'$D(^TIU(8925,TIUDA,"TEXT")) D
. D GETTIU^TIULD(.TIU,TIUDA)
. D MERGTEXT^TIUEDI1(TIUDA,.TIU)
. K ^TIU(8925,TIUDA,"TEMP")
K TIU
D SIGN^TIUSRVP(.ERROR,TIUDA,SIGN)
I 'ERROR S II=II+1,@DATA@(II)="1^"_$C(30) G DONE
S II=II+1,@DATA@(II)="-1^"_$P(ERROR,"^",2)_$C(30)
G DONE
;
SIG(DATA,SIGN) ;EP -- BTPW TIU SIG VALIDATE
NEW UID,II,RESULT,ERROR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWSIGVAL",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S II=0,@DATA@(II)="I00010RESULT^T00080MESSAGE"_$C(30)
S SIGN=$$DECRYP^XUSRB1(SIGN)
D SIGCHK^BMXRPC3(.RESULT,SIGN)
I RESULT=0 S RESULT=-1,MSG="Signature not validated" S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30) G DONE
S II=II+1,@DATA@(II)="1^"_$C(30)
G DONE
BTPWTIUT ;VNGT/HS/ALA-TIU Utilities ; 10 Dec 2009 9:41 AM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
+3 ;
BL(DATA,TMPIEN) ; EP - BTPW GET TIU TEMPL BOILER
+1 NEW UID,II,TIUY,TEXT,NTEXT
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWTIBLR",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER"
+7 ;
+8 SET @DATA@(II)="T01024REPORT_TEXT"_$CHAR(30)
+9 DO GETBOIL^TIUSRVT(.TIUY,TMPIEN)
+10 SET N=""
+11 FOR
SET N=$ORDER(@TIUY@(N))
IF N=""
QUIT
Begin DoDot:1
+12 SET TEXT=@TIUY@(N)
SET NTEXT=$GET(@TIUY@(N+1))
+13 IF NTEXT["}"
IF NTEXT'["{"
SET TEXT=TEXT_NTEXT
SET N=N+1
+14 SET II=II+1
SET @DATA@(II)=TEXT_$CHAR(10)
End DoDot:1
+15 ;
+16 KILL @TIUY
+17 ;
+18 ; Check for subtemplate items boilerplate
+19 NEW TITM,SBTIEN,N,TEXT,NTEXT
+20 SET TITM=0
+21 FOR
SET TITM=$ORDER(^TIU(8927,TMPIEN,10,TITM))
IF 'TITM
QUIT
Begin DoDot:1
+22 SET SBTIEN=$PIECE(^TIU(8927,TMPIEN,10,TITM,0),"^",2)
+23 DO GETBOIL^TIUSRVT(.TIUY,SBTIEN)
+24 SET N=""
+25 FOR
SET N=$ORDER(@TIUY@(N))
IF N=""
QUIT
Begin DoDot:2
+26 SET TEXT=@TIUY@(N)
SET NTEXT=$GET(@TIUY@(N+1))
+27 IF NTEXT["}"
IF NTEXT'["{"
SET TEXT=TEXT_NTEXT
SET N=N+1
+28 SET II=II+1
SET @DATA@(II)=TEXT_$CHAR(10)
+29 KILL @TIUY
End DoDot:2
End DoDot:1
+30 ;
+31 SET @DATA@(II)=@DATA@(II)_$CHAR(30)
+32 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+33 KILL @TIUY
+34 QUIT
+35 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
IT(DATA,TMPIEN) ; EP - BTPW GET TIU TEMPL ITEMS
+1 NEW UID,II,TIUY
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWTIITM",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER"
+7 ;
+8 SET @DATA@(II)="T00030OBJECT^I00010OBJ_IEN^I00010LINE"_$CHAR(30)
+9 DO GETBOIL^TIUSRVT(.TIUY,TMPIEN)
+10 ;S N=""
+11 ;F S N=$O(@TIUY@(N)) Q:N="" S II=II+1,@DATA@(II)=@TIUY@(N)_$C(10)
+12 DO GTIT(.TIUY)
+13 KILL @TIUY
+14 ; Check for sub template items
+15 NEW TITM,SBTIEN
+16 SET TITM=0
+17 FOR
SET TITM=$ORDER(^TIU(8927,TMPIEN,10,TITM))
IF 'TITM
QUIT
Begin DoDot:1
+18 SET SBTIEN=$PIECE(^TIU(8927,TMPIEN,10,TITM,0),"^",2)
+19 DO GETBOIL^TIUSRVT(.TIUY,SBTIEN)
+20 ;S N=""
+21 ;F S N=$O(@TIUY@(N)) Q:N="" S II=II+1,@DATA@(II)=@TIUY@(N)_$C(10)
+22 DO GTIT(.TIUY)
+23 KILL @TIUY
End DoDot:1
+24 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+25 KILL @TIUY
+26 QUIT
+27 ;
OBJ(DATA,OBIEN) ;EP - BTPW GET TIU OBJECT DEF
+1 NEW UID,II,TIUY,TY,DTY,ITEMS,BJ,TXT,HDR,LENG,DEFTXT,DEFINDX,REQ,SEPL,MAX,INDENT
+2 NEW PAD,MINV,MAXV,INCR,URL
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BTPWTIOBJ",UID))
+5 KILL @DATA
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER"
+8 ;
+9 SET HDR="I00010OBJ_IEN^T00030TYPE^T00030DATE_TYPE^T00006LENGTH^T00075DEFAULT_TEXT^T00005DEFINDX^T00003REQ^"
+10 SET HDR=HDR_"T00003SEP_LINE^T00003MAX_LEN^T00002INDENT^T00002PAD^T00004MIN_VAL^T00004MAX_VAL^T00003INCREMENT^"
+11 SET HDR=HDR_"T00240URL^T01024ITEMS"
+12 SET @DATA@(II)=HDR_$CHAR(30)
+13 DO LOADIEN^TIUSRVF(.TIUY,OBIEN)
+14 SET BJ=1
+15 ; Get definition values
+16 SET TY=$PIECE(TIUY(BJ),U,2)
SET LENG=$PIECE(TIUY(BJ),U,4)
SET DEFTXT=$PIECE(TIUY(BJ),U,5)
SET DEFINDX=$PIECE(TIUY(BJ),U,7)
+17 SET REQ=$$STC^BQIUL2(8927.1,.08,$PIECE(TIUY(BJ),U,8))
SET SEPL=$$STC^BQIUL2(8927.1,.09,$PIECE(TIUY(BJ),U,9))
+18 SET MAX=$PIECE(TIUY(BJ),U,10)
SET INDENT=$PIECE(TIUY(BJ),U,11)
SET PAD=$PIECE(TIUY(BJ),U,12)
SET MINV=$PIECE(TIUY(BJ),U,13)
+19 SET MAXV=$PIECE(TIUY(BJ),U,14)
SET INCR=$PIECE(TIUY(BJ),U,15)
SET URL=$GET(^TIU(8927.1,OBIEN,3))
+20 IF TY="D"
SET DTY=$PIECE(TIUY(BJ),U,16)
SET DTY=$$STC^BQIUL2(8927.1,.16,TY)
+21 SET TY=$$STC^BQIUL2(8927.1,.02,TY)
+22 ; Get items
+23 SET ITEMS=""
+24 FOR
SET BJ=$ORDER(TIUY(BJ))
IF BJ=""
QUIT
Begin DoDot:1
+25 IF $PIECE(TIUY(BJ),U,1)="I"
SET TXT=$PIECE(TIUY(BJ),U,2)
SET ITEMS=ITEMS_TXT_$CHAR(29)
End DoDot:1
+26 SET ITEMS=$$TKO^BQIUL1(ITEMS,$CHAR(29))
+27 SET II=II+1
SET @DATA@(II)=OBIEN_U_TY_U_$GET(DTY)_U_LENG_U_DEFTXT_U_DEFINDX_U_REQ_U_SEPL_U_MAX_U_INDENT_U_PAD_U_MINV_U_MAXV_U_INCR_U_URL_U_ITEMS_$CHAR(30)
+28 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+29 QUIT
+30 ;
GTIT(TIUY) ; Get items from boilerplate
+1 NEW BI,BJ,IEN,VAL
+2 KILL TIUX
+3 SET BI=0
SET BJ=0
+4 FOR
SET BI=$ORDER(@TIUY@(BI))
IF BI=""
QUIT
Begin DoDot:1
+5 NEW VALUE
+6 SET VALUE=@TIUY@(BI)
+7 IF VALUE["{FLD:"
Begin DoDot:2
+8 NEW X,XLEN,VAR
+9 SET X=VALUE
SET XLEN=$LENGTH(X)
+10 SET X=$$DOLMLINE^TIUSRVF1(X)
+11 ; If the length of the updated line is NOT less than the original
+12 ; line length, then it should have translated okay
+13 IF $LENGTH(X)'<XLEN
SET VALUE=X
QUIT
+14 SET X=VALUE
+15 NEW I,J
+16 FOR
SET I=$FIND(X,"{FLD:")
IF 'I
QUIT
Begin DoDot:3
+17 SET J=$FIND(X,"}",I)
+18 IF J>0
SET NAME=$EXTRACT(X,I,J-2)
+19 IF J=0
IF X["{"
SET X=X_@TIUY@(BI+1)
QUIT
+20 IF J=0
IF X'["{"
SET NAME=""
SET J=I
QUIT
+21 SET IEN=$ORDER(^TIU(8927.1,"B",NAME,""))
+22 SET VAL="{FLD:"_NAME_"}"
+23 SET BJ=BJ+1
SET @DATA@(BJ)=VAL_U_IEN_U_BI_$CHAR(30)
SET II=BJ
+24 SET X=$PIECE(X,VAL,2)
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
DEL(DATA,TIUDA) ;EP -- BTPW DELETE TIU DOCUMENT
+1 NEW UID,II,ERROR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWTIDEL",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER"
+7 SET II=0
SET @DATA@(II)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+8 DO DELETE^TIUSRVP(.ERROR,TIUDA,"")
+9 IF 'ERROR
SET II=II+1
SET @DATA@(II)="1^"_$CHAR(30)
GOTO DONE
+10 SET II=II+1
SET @DATA@(II)="-1^"_$PIECE(ERROR,"^",2)_$CHAR(30)
+11 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
SIGN(DATA,TIUDA,SIGN) ;EP -- BTPW SIGN TIU DOCUMENT
+1 NEW UID,II,RESULT,SIG,SUPRESS,ERROR,TIUX
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWTISIG",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER"
+7 SET II=0
SET @DATA@(II)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+8 SET SIGN=$$DECRYP^XUSRB1(SIGN)
+9 DO SIGCHK^BMXRPC3(.RESULT,SIGN)
+10 IF RESULT=0
SET RESULT=-1
SET MSG="Signature not validated"
SET II=II+1
SET @DATA@(II)=RESULT_U_MSG_$CHAR(30)
GOTO DONE
+11 IF $EXTRACT(SIGN,1)'=" "
SET SIGN=" "_SIGN_" "
+12 DO VALIDSIG^ORWU(.SIG,SIGN)
+13 SET SUPRESS=0
IF SIG
SET SUPRESS=1
+14 IF $DATA(^TIU(8925,TIUDA,"TEMP"))
IF '$DATA(^TIU(8925,TIUDA,"TEXT"))
Begin DoDot:1
+15 DO GETTIU^TIULD(.TIU,TIUDA)
+16 DO MERGTEXT^TIUEDI1(TIUDA,.TIU)
+17 KILL ^TIU(8925,TIUDA,"TEMP")
End DoDot:1
+18 KILL TIU
+19 DO SIGN^TIUSRVP(.ERROR,TIUDA,SIGN)
+20 IF 'ERROR
SET II=II+1
SET @DATA@(II)="1^"_$CHAR(30)
GOTO DONE
+21 SET II=II+1
SET @DATA@(II)="-1^"_$PIECE(ERROR,"^",2)_$CHAR(30)
+22 GOTO DONE
+23 ;
SIG(DATA,SIGN) ;EP -- BTPW TIU SIG VALIDATE
+1 NEW UID,II,RESULT,ERROR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWSIGVAL",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTIUT D UNWIND^%ZTER"
+7 SET II=0
SET @DATA@(II)="I00010RESULT^T00080MESSAGE"_$CHAR(30)
+8 SET SIGN=$$DECRYP^XUSRB1(SIGN)
+9 DO SIGCHK^BMXRPC3(.RESULT,SIGN)
+10 IF RESULT=0
SET RESULT=-1
SET MSG="Signature not validated"
SET II=II+1
SET @DATA@(II)=RESULT_U_MSG_$CHAR(30)
GOTO DONE
+11 SET II=II+1
SET @DATA@(II)="1^"_$CHAR(30)
+12 GOTO DONE
