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

BTPWTIUN.m

Go to the documentation of this file. 
  1. BTPWTIUN ;VNGT/HS/ALA-Create TIU Note for CMET ; 24 Aug 2009  6:50 PM
  1.  ;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17
  1.  ;
  1. EN(BTPWDFN,BTPWVIEN,BTPWTIT,BTPWTMP,SUBJ,SIGN,PARMS) ; EP - Create a TIU note
  1.  ; Input
  1.  ;   BTPWDFN  = Patient IEN
  1.  ;   BTPWVIEN = Visit IEN
  1.  ;   BTPWTIT  = Document Title IEN
  1.  ;   BTPWTMP  = Template IEN
  1.  ;   SUBJ     = Subject header
  1.  ;   SIGN     = Electronic Signature
  1.  ;   PARMS    = Parameters needed for the letter
  1.  ;
  1.  NEW TIUDA,N,BTPWVIS,TIUX,RESULT
  1.  S DATA="BTPWVIS"
  1.  D LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
  1.  ;
  1.  S N=0
  1.  F  S N=$O(BTPWVIS(N)) Q:N=""  D
  1.  . I $P(BTPWVIS(N),U,1)="VST",$P(BTPWVIS(N),U,2)="HL" S TIUX(1205)=$P(BTPWVIS(4),U,3) Q
  1.  . I $P(BTPWVIS(N),U,1)="HDR" S VSTR=$P(BTPWVIS(N),U,4)
  1.  S TIUX(1202)=DUZ
  1.  S TIUX(1301)=$$NOW^XLFDT()
  1.  ; Subject (may need to be passed)
  1.  I $G(SUBJ)="" S SUBJ="CMET Document"
  1.  S TIUX(1701)=SUBJ
  1.  S TIUX("VISIT")=BTPWVIEN
  1.  ;  Create the document
  1.  D MAKE^TIUSRVP(.RESULT,BTPWDFN,BTPWTIT,"","",BTPWVIEN,.TIUX,"",1,"")
  1.  S TIUDA=RESULT
  1.  ;  Lock the document
  1.  D LOCK^TIUSRVP(.ERROR,TIUDA)
  1.  I ERROR Q
  1.  ;  Get the boilerplate
  1.  D GETBOIL^TIUSRVT(.TIUY,BTPWTMP)
  1.  K TIUX
  1.  S I=0 F  S I=$O(@TIUY@(I)) Q:I=""  D
  1.  . NEW VALUE
  1.  . S VALUE=@TIUY@(I)
  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.  .. S VAR=$P(X,"}",1),VAR=$P(VAR,":",2)
  1.  .. I $D(PARMS(VAR)) D
  1.  ... S NVAL=PARMS(VAR)
  1.  ... S BL=$F(X,"{") S:BL=2 BL=1
  1.  ... S BE=$F(X,"}")
  1.  ... S NVALUE=""
  1.  ... I BL=1 S NVALUE=NVAL_$E(X,BE,$L(X)) Q
  1.  ... S NVALUE=$E(X,BL,BE)_NVAL_$E(X,BE,$L(X))
  1.  .. S VALUE=NVALUE
  1.  . S TIUX(I,0)=VALUE
  1.  ;  Replace boilerplate with data
  1.  K ^TMP("TIUBOIL",$J)
  1.  D GETTEXT^TIUSRVT(.TIUY,BTPWDFN,VSTR,.TIUX)
  1.  I $E(SIGN,1)'=" " S SIGN=" "_SIGN_" "
  1.  ;  Check for valid signature
  1.  D VALIDSIG^ORWU(.SIG,SIGN)
  1.  S SUPRESS=0 I SIG S SUPRESS=1
  1.  ;
  1.  ;  Set the text into the document
  1.  K TIUX
  1.  S I=0 F  S I=$O(@TIUY@(I)) Q:I=""  S TIUX("TEXT",I,0)=@TIUY@(I,0)
  1.  S TIUX("HDR")="1^1"
  1.  D SETTEXT^TIUSRVPT(.TIUY,TIUDA,.TIUX,SUPRESS)
  1.  ;  Set the signature into the document
  1.  D SIGN^TIUSRVP(.ERROR,TIUDA,SIGN)
  1.  ;  Unlock the document
  1.  D UNLOCK^TIUSRVP(.ERROR,TIUDA)
  1.  ;
  1.  K TIUX,TMPN,VISIT,VSTR,X,TIUY,BTPWVIS,BE,BL,D,D0,DATA,DOCN,DG,DIC,DIW
  1.  K N,NVAL,NVALUE,SIG,SIGN,SUPRESS,TIUPRM0,TIUPRM1
  1.  Q TIUDA
  1.  ;
  1. ERR ;
  1.  ;
  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.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. PTXT(NDATA,BTPWDFN,BTPWVIEN,BTPWTMP,SUBJ) ; EP - BTPW GET NOTE
  1.  NEW II,UID,DATA,TEXT,VSTR
  1.  S II=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTINT D UNWIND^%ZTER" ; SAC 2006 2.2.3
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S NDATA=$NA(^TMP("BTPWTIUN",UID))
  1.  K @NDATA
  1.  ;
  1.  ; Create Chart Review
  1.  I $G(BTPWVIEN)="" D
  1.  . S BTPWVIEN=$$EN^BTPWPCHT(1,BTPWDFN,1)
  1.  ;
  1.  I BTPWVIEN=-1 D  Q
  1.  . S @NDATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
  1.  . S II=II+1,@NDATA@(II)="-1^Unable to create Visit Record^"_$C(30)
  1.  . S II=II+1,@NDATA@(II)=$C(31)
  1.  ;
  1.  NEW TIUDA,N,BTPWVIS,TIUX,RESULT,TIUY,TT,XWBOS,TEXT
  1.  S DATA="BTPWVIS"
  1.  D LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
  1.  ;
  1.  S N=0
  1.  F  S N=$O(BTPWVIS(N)) Q:N=""  D
  1.  . I $P(BTPWVIS(N),U,1)="VST",$P(BTPWVIS(N),U,2)="HL" S TIUX(1205)=$P(BTPWVIS(4),U,3) Q
  1.  . I $P(BTPWVIS(N),U,1)="HDR" S VSTR=$P(BTPWVIS(N),U,4)
  1.  S TIUX(1202)=DUZ
  1.  S TIUX(1301)=$$NOW^XLFDT()
  1.  ; Subject (may need to be passed)
  1.  I $G(SUBJ)="" S SUBJ="CMET Document"
  1.  S TIUX(1701)=SUBJ
  1.  S TIUX("VISIT")=BTPWVIEN
  1.  ;
  1.  D GETBOIL^TIUSRVT(.TIUY,BTPWTMP)
  1.  K TIUX
  1.  S I=0 F  S I=$O(@TIUY@(I)) Q:I=""  S TIUX(I,0)=@TIUY@(I)
  1.  ;  Replace boilerplate with data
  1.  K ^TMP("TIUBOIL",$J)
  1.  ; Variable needs to be set for the "{FLD:} values to stay in the text
  1.  S XWBOS=1
  1.  D GETTEXT^TIUSRVT(.TIUY,BTPWDFN,VSTR,.TIUX)
  1.  K XWBOS
  1.  S @NDATA@(II)="I00010BTPWVIEN^T32000NOTE_TEXT"_$C(30)
  1.  S II=II+1,@NDATA@(II)=BTPWVIEN_U,TEXT=""
  1.  S TT=0 F  S TT=$O(@TIUY@(TT)) Q:'TT  S TEXT=TEXT_@TIUY@(TT,0)_$C(10)
  1.  S TEXT=$$TKO^BQIUL1(TEXT,$C(10))
  1.  S @NDATA@(II)=@NDATA@(II)_TEXT_$C(30)
  1.  S II=II+1,@NDATA@(II)=$C(31)
  1.  K @TIUY
  1.  Q