BTPWTIUN ;VNGT/HS/ALA-Create TIU Note for CMET ; 24 Aug 2009 6:50 PM
;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17
;
EN(BTPWDFN,BTPWVIEN,BTPWTIT,BTPWTMP,SUBJ,SIGN,PARMS) ; EP - Create a TIU note
; Input
; BTPWDFN = Patient IEN
; BTPWVIEN = Visit IEN
; BTPWTIT = Document Title IEN
; BTPWTMP = Template IEN
; SUBJ = Subject header
; SIGN = Electronic Signature
; PARMS = Parameters needed for the letter
;
NEW TIUDA,N,BTPWVIS,TIUX,RESULT
S DATA="BTPWVIS"
D LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
;
S N=0
F S N=$O(BTPWVIS(N)) Q:N="" D
. I $P(BTPWVIS(N),U,1)="VST",$P(BTPWVIS(N),U,2)="HL" S TIUX(1205)=$P(BTPWVIS(4),U,3) Q
. I $P(BTPWVIS(N),U,1)="HDR" S VSTR=$P(BTPWVIS(N),U,4)
S TIUX(1202)=DUZ
S TIUX(1301)=$$NOW^XLFDT()
; Subject (may need to be passed)
I $G(SUBJ)="" S SUBJ="CMET Document"
S TIUX(1701)=SUBJ
S TIUX("VISIT")=BTPWVIEN
; Create the document
D MAKE^TIUSRVP(.RESULT,BTPWDFN,BTPWTIT,"","",BTPWVIEN,.TIUX,"",1,"")
S TIUDA=RESULT
; Lock the document
D LOCK^TIUSRVP(.ERROR,TIUDA)
I ERROR Q
; Get the boilerplate
D GETBOIL^TIUSRVT(.TIUY,BTPWTMP)
K TIUX
S I=0 F S I=$O(@TIUY@(I)) Q:I="" D
. NEW VALUE
. S VALUE=@TIUY@(I)
. 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
.. S VAR=$P(X,"}",1),VAR=$P(VAR,":",2)
.. I $D(PARMS(VAR)) D
... S NVAL=PARMS(VAR)
... S BL=$F(X,"{") S:BL=2 BL=1
... S BE=$F(X,"}")
... S NVALUE=""
... I BL=1 S NVALUE=NVAL_$E(X,BE,$L(X)) Q
... S NVALUE=$E(X,BL,BE)_NVAL_$E(X,BE,$L(X))
.. S VALUE=NVALUE
. S TIUX(I,0)=VALUE
; Replace boilerplate with data
K ^TMP("TIUBOIL",$J)
D GETTEXT^TIUSRVT(.TIUY,BTPWDFN,VSTR,.TIUX)
I $E(SIGN,1)'=" " S SIGN=" "_SIGN_" "
; Check for valid signature
D VALIDSIG^ORWU(.SIG,SIGN)
S SUPRESS=0 I SIG S SUPRESS=1
;
; Set the text into the document
K TIUX
S I=0 F S I=$O(@TIUY@(I)) Q:I="" S TIUX("TEXT",I,0)=@TIUY@(I,0)
S TIUX("HDR")="1^1"
D SETTEXT^TIUSRVPT(.TIUY,TIUDA,.TIUX,SUPRESS)
; Set the signature into the document
D SIGN^TIUSRVP(.ERROR,TIUDA,SIGN)
; Unlock the document
D UNLOCK^TIUSRVP(.ERROR,TIUDA)
;
K TIUX,TMPN,VISIT,VSTR,X,TIUY,BTPWVIS,BE,BL,D,D0,DATA,DOCN,DG,DIC,DIW
K N,NVAL,NVALUE,SIG,SIGN,SUPRESS,TIUPRM0,TIUPRM1
Q TIUDA
;
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
S II=II+1,@DATA@(II)=$C(31)
Q
;
PTXT(NDATA,BTPWDFN,BTPWVIEN,BTPWTMP,SUBJ) ; EP - BTPW GET NOTE
NEW II,UID,DATA,TEXT,VSTR
S II=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTINT D UNWIND^%ZTER" ; SAC 2006 2.2.3
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S NDATA=$NA(^TMP("BTPWTIUN",UID))
K @NDATA
;
; Create Chart Review
I $G(BTPWVIEN)="" D
. S BTPWVIEN=$$EN^BTPWPCHT(1,BTPWDFN,1)
;
I BTPWVIEN=-1 D Q
. S @NDATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
. S II=II+1,@NDATA@(II)="-1^Unable to create Visit Record^"_$C(30)
. S II=II+1,@NDATA@(II)=$C(31)
;
NEW TIUDA,N,BTPWVIS,TIUX,RESULT,TIUY,TT,XWBOS,TEXT
S DATA="BTPWVIS"
D LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
;
S N=0
F S N=$O(BTPWVIS(N)) Q:N="" D
. I $P(BTPWVIS(N),U,1)="VST",$P(BTPWVIS(N),U,2)="HL" S TIUX(1205)=$P(BTPWVIS(4),U,3) Q
. I $P(BTPWVIS(N),U,1)="HDR" S VSTR=$P(BTPWVIS(N),U,4)
S TIUX(1202)=DUZ
S TIUX(1301)=$$NOW^XLFDT()
; Subject (may need to be passed)
I $G(SUBJ)="" S SUBJ="CMET Document"
S TIUX(1701)=SUBJ
S TIUX("VISIT")=BTPWVIEN
;
D GETBOIL^TIUSRVT(.TIUY,BTPWTMP)
K TIUX
S I=0 F S I=$O(@TIUY@(I)) Q:I="" S TIUX(I,0)=@TIUY@(I)
; Replace boilerplate with data
K ^TMP("TIUBOIL",$J)
; Variable needs to be set for the "{FLD:} values to stay in the text
S XWBOS=1
D GETTEXT^TIUSRVT(.TIUY,BTPWDFN,VSTR,.TIUX)
K XWBOS
S @NDATA@(II)="I00010BTPWVIEN^T32000NOTE_TEXT"_$C(30)
S II=II+1,@NDATA@(II)=BTPWVIEN_U,TEXT=""
S TT=0 F S TT=$O(@TIUY@(TT)) Q:'TT S TEXT=TEXT_@TIUY@(TT,0)_$C(10)
S TEXT=$$TKO^BQIUL1(TEXT,$C(10))
S @NDATA@(II)=@NDATA@(II)_TEXT_$C(30)
S II=II+1,@NDATA@(II)=$C(31)
K @TIUY
Q
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
+2 ;
EN(BTPWDFN,BTPWVIEN,BTPWTIT,BTPWTMP,SUBJ,SIGN,PARMS) ; EP - Create a TIU note
+1 ; Input
+2 ; BTPWDFN = Patient IEN
+3 ; BTPWVIEN = Visit IEN
+4 ; BTPWTIT = Document Title IEN
+5 ; BTPWTMP = Template IEN
+6 ; SUBJ = Subject header
+7 ; SIGN = Electronic Signature
+8 ; PARMS = Parameters needed for the letter
+9 ;
+10 NEW TIUDA,N,BTPWVIS,TIUX,RESULT
+11 SET DATA="BTPWVIS"
+12 DO LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
+13 ;
+14 SET N=0
+15 FOR
SET N=$ORDER(BTPWVIS(N))
IF N=""
QUIT
Begin DoDot:1
+16 IF $PIECE(BTPWVIS(N),U,1)="VST"
IF $PIECE(BTPWVIS(N),U,2)="HL"
SET TIUX(1205)=$PIECE(BTPWVIS(4),U,3)
QUIT
+17 IF $PIECE(BTPWVIS(N),U,1)="HDR"
SET VSTR=$PIECE(BTPWVIS(N),U,4)
End DoDot:1
+18 SET TIUX(1202)=DUZ
+19 SET TIUX(1301)=$$NOW^XLFDT()
+20 ; Subject (may need to be passed)
+21 IF $GET(SUBJ)=""
SET SUBJ="CMET Document"
+22 SET TIUX(1701)=SUBJ
+23 SET TIUX("VISIT")=BTPWVIEN
+24 ; Create the document
+25 DO MAKE^TIUSRVP(.RESULT,BTPWDFN,BTPWTIT,"","",BTPWVIEN,.TIUX,"",1,"")
+26 SET TIUDA=RESULT
+27 ; Lock the document
+28 DO LOCK^TIUSRVP(.ERROR,TIUDA)
+29 IF ERROR
QUIT
+30 ; Get the boilerplate
+31 DO GETBOIL^TIUSRVT(.TIUY,BTPWTMP)
+32 KILL TIUX
+33 SET I=0
FOR
SET I=$ORDER(@TIUY@(I))
IF I=""
QUIT
Begin DoDot:1
+34 NEW VALUE
+35 SET VALUE=@TIUY@(I)
+36 IF VALUE["{FLD:"
Begin DoDot:2
+37 NEW X,XLEN,VAR
+38 SET X=VALUE
SET XLEN=$LENGTH(X)
+39 SET X=$$DOLMLINE^TIUSRVF1(X)
+40 ; If the length of the updated line is NOT less than the original
+41 ; line length, then it should have translated okay
+42 IF $LENGTH(X)'<XLEN
SET VALUE=X
QUIT
+43 SET X=VALUE
+44 SET VAR=$PIECE(X,"}",1)
SET VAR=$PIECE(VAR,":",2)
+45 IF $DATA(PARMS(VAR))
Begin DoDot:3
+46 SET NVAL=PARMS(VAR)
+47 SET BL=$FIND(X,"{")
IF BL=2
SET BL=1
+48 SET BE=$FIND(X,"}")
+49 SET NVALUE=""
+50 IF BL=1
SET NVALUE=NVAL_$EXTRACT(X,BE,$LENGTH(X))
QUIT
+51 SET NVALUE=$EXTRACT(X,BL,BE)_NVAL_$EXTRACT(X,BE,$LENGTH(X))
End DoDot:3
+52 SET VALUE=NVALUE
End DoDot:2
+53 SET TIUX(I,0)=VALUE
End DoDot:1
+54 ; Replace boilerplate with data
+55 KILL ^TMP("TIUBOIL",$JOB)
+56 DO GETTEXT^TIUSRVT(.TIUY,BTPWDFN,VSTR,.TIUX)
+57 IF $EXTRACT(SIGN,1)'=" "
SET SIGN=" "_SIGN_" "
+58 ; Check for valid signature
+59 DO VALIDSIG^ORWU(.SIG,SIGN)
+60 SET SUPRESS=0
IF SIG
SET SUPRESS=1
+61 ;
+62 ; Set the text into the document
+63 KILL TIUX
+64 SET I=0
FOR
SET I=$ORDER(@TIUY@(I))
IF I=""
QUIT
SET TIUX("TEXT",I,0)=@TIUY@(I,0)
+65 SET TIUX("HDR")="1^1"
+66 DO SETTEXT^TIUSRVPT(.TIUY,TIUDA,.TIUX,SUPRESS)
+67 ; Set the signature into the document
+68 DO SIGN^TIUSRVP(.ERROR,TIUDA,SIGN)
+69 ; Unlock the document
+70 DO UNLOCK^TIUSRVP(.ERROR,TIUDA)
+71 ;
+72 KILL TIUX,TMPN,VISIT,VSTR,X,TIUY,BTPWVIS,BE,BL,D,D0,DATA,DOCN,DG,DIC,DIW
+73 KILL N,NVAL,NVALUE,SIG,SIGN,SUPRESS,TIUPRM0,TIUPRM1
+74 QUIT TIUDA
+75 ;
ERR ;
+1 ;
+2 DO ^%ZTER
+3 NEW Y,ERRDTM
+4 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+5 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+6 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+7 QUIT
+8 ;
PTXT(NDATA,BTPWDFN,BTPWVIEN,BTPWTMP,SUBJ) ; EP - BTPW GET NOTE
+1 NEW II,UID,DATA,TEXT,VSTR
+2 SET II=0
+3 ;
+4 ; SAC 2006 2.2.3
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTINT D UNWIND^%ZTER"
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET NDATA=$NAME(^TMP("BTPWTIUN",UID))
+7 KILL @NDATA
+8 ;
+9 ; Create Chart Review
+10 IF $GET(BTPWVIEN)=""
Begin DoDot:1
+11 SET BTPWVIEN=$$EN^BTPWPCHT(1,BTPWDFN,1)
End DoDot:1
+12 ;
+13 IF BTPWVIEN=-1
Begin DoDot:1
+14 SET @NDATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$CHAR(30)
+15 SET II=II+1
SET @NDATA@(II)="-1^Unable to create Visit Record^"_$CHAR(30)
+16 SET II=II+1
SET @NDATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+17 ;
+18 NEW TIUDA,N,BTPWVIS,TIUX,RESULT,TIUY,TT,XWBOS,TEXT
+19 SET DATA="BTPWVIS"
+20 DO LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
+21 ;
+22 SET N=0
+23 FOR
SET N=$ORDER(BTPWVIS(N))
IF N=""
QUIT
Begin DoDot:1
+24 IF $PIECE(BTPWVIS(N),U,1)="VST"
IF $PIECE(BTPWVIS(N),U,2)="HL"
SET TIUX(1205)=$PIECE(BTPWVIS(4),U,3)
QUIT
+25 IF $PIECE(BTPWVIS(N),U,1)="HDR"
SET VSTR=$PIECE(BTPWVIS(N),U,4)
End DoDot:1
+26 SET TIUX(1202)=DUZ
+27 SET TIUX(1301)=$$NOW^XLFDT()
+28 ; Subject (may need to be passed)
+29 IF $GET(SUBJ)=""
SET SUBJ="CMET Document"
+30 SET TIUX(1701)=SUBJ
+31 SET TIUX("VISIT")=BTPWVIEN
+32 ;
+33 DO GETBOIL^TIUSRVT(.TIUY,BTPWTMP)
+34 KILL TIUX
+35 SET I=0
FOR
SET I=$ORDER(@TIUY@(I))
IF I=""
QUIT
SET TIUX(I,0)=@TIUY@(I)
+36 ; Replace boilerplate with data
+37 KILL ^TMP("TIUBOIL",$JOB)
+38 ; Variable needs to be set for the "{FLD:} values to stay in the text
+39 SET XWBOS=1
+40 DO GETTEXT^TIUSRVT(.TIUY,BTPWDFN,VSTR,.TIUX)
+41 KILL XWBOS
+42 SET @NDATA@(II)="I00010BTPWVIEN^T32000NOTE_TEXT"_$CHAR(30)
+43 SET II=II+1
SET @NDATA@(II)=BTPWVIEN_U
SET TEXT=""
+44 SET TT=0
FOR
SET TT=$ORDER(@TIUY@(TT))
IF 'TT
QUIT
SET TEXT=TEXT_@TIUY@(TT,0)_$CHAR(10)
+45 SET TEXT=$$TKO^BQIUL1(TEXT,$CHAR(10))
+46 SET @NDATA@(II)=@NDATA@(II)_TEXT_$CHAR(30)
+47 SET II=II+1
SET @NDATA@(II)=$CHAR(31)
+48 KILL @TIUY
+49 QUIT
