Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTPWTIUT

BTPWTIUT.m

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