BTPWTINT ;VNGT/HS/ALA-TIU Note Text ; 28 Mar 2010 6:59 PM
;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17
;
;
EN(NDATA,BTPWDFN,BTPWVIEN,BTPWTIT,SUBJ,SIGN,TIUDA,BTPWNOT,TEXT) ; EP - BTPW SET NOTE
; Input
; BTPWDFN = Patient IEN
; BTPWVIEN = Visit IEN
; BTPWTIT = Document Title IEN
; SUBJ = Subject header
; SIGN = Electronic Signature
; TIUDA = Existing Note IEN
; BTPWNOT = Notification type
; TEXT = Note text
;
NEW II,UID,MORE,BN,LINE,CT,NBN
; Create chart review visit
; BTPWVIEN = Visit IEN
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("BTPWTINT",UID)),TEMP=$NA(^TMP("BTPWNOTE",UID))
K @NDATA,@TEMP
;
I $D(TEXT)>1 D
. S BN="",LINE="",CT=0
. F S BN=$O(TEXT(BN)) Q:BN="" D
.. S NBN=$O(TEXT(BN))
.. S LINE=LINE_TEXT(BN) I NBN'="" S LINE=LINE_TEXT(NBN)
.. I NBN'="" D
... F BQ=1:1:$L(LINE,$C(10))-1 S CT=CT+1,@TEMP@(CT)=$P(LINE,$C(10),BQ)
... S LINE=$P(LINE,$C(10),BQ+1,$L(LINE,$C(10)))
... S BN=NBN
.. I NBN="" D
... F BQ=1:1:$L(LINE,$C(10)) S CT=CT+1,@TEMP@(CT)=$P(LINE,$C(10),BQ)
I $D(TEXT)=1 D
. S LINE=TEXT,CT=0
. F BQ=1:1:$L(LINE,$C(10)) S CT=CT+1,@TEMP@(CT)=$P(LINE,$C(10),BQ)
;
I $G(TIUDA)'="" D Q
. NEW TIUX,BN,RESULT,MSG,ERROR
. K TIUX
. S TIUX("HDR")="1^1"
. S BN=0 F S BN=$O(@TEMP@(BN)) Q:BN="" S TIUX("TEXT",BN,0)=@TEMP@(BN)
. D UPDATE^TIUSRVP(.ERROR,TIUDA,.TIUX,1)
. S RESULT=1,MSG=""
. I $P($G(ERROR),U,1)=0 S RESULT=-1,MSG=$P($G(ERROR),U,2)
. S @NDATA@(II)="I00010RESULT^T00080MESSAGE^I00010BTPWVIEN^I00010TIUDA"_$C(30)
. S II=II+1,@NDATA@(II)=RESULT_U_MSG_U_BTPWVIEN_U_TIUDA_$C(30)
. S II=II+1,@NDATA@(II)=$C(31)
. K @TEMP
;
S MORE=$S($G(BTPWVIEN)'="":"",1:1)
S NOTTYP=$S($G(BTPWNOT)="P":4,$G(BTPWNOT)="L":1,1:$G(BTPWNOT))
S APCDCAT=$S($G(BTPWNOT)=4:"T",$G(BTPWNOT)="P":"T",1:"C")
;
; Create Chart Review
I $G(BTPWVIEN)="" D
. S BTPWVIEN=$$EN^BTPWPCHT($G(NOTTYP),BTPWDFN,1)
I BTPWVIEN=-1 D Q
. S @NDATA@(II)="I00010RESULT^T00080MESSAGE^I00010BTPWVIEN"_$C(30)
. S II=II+1,@NDATA@(II)="-1^Unable to create Visit Record^"_$C(30)
. S II=II+1,@NDATA@(II)=$C(31)
; Get visit data
NEW TIUDA,N,BTPWVIS,TIUX,RESULT
S DATA="BTPWVIS"
D LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
;
I $G(SUBJ)="" S SUBJ="CMET Notification"
;
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)
S TIUX(1701)=SUBJ
S TIUX("VISIT")=BTPWVIEN
; Create TIU record
D MAKE^TIUSRVP(.RESULT,BTPWDFN,BTPWTIT,"","",BTPWVIEN,.TIUX,"",1,"")
S TIUDA=RESULT
; Save document RPC - TIU SET DOCUMENT TEXT
; TIUX("HDR")=<# of Current Page>^<Total # of Pages>
; TIUX("TEXT",1,0)=<Line 1 of document body>
; TIUX("TEXT",2,0)=<Line 2 of document body>
; TIUX("TEXT",3,0)=<Line 3 of document body>
K TIUX
S TIUX("HDR")="1^1"
S BN=0 F S BN=$O(@TEMP@(BN)) Q:BN="" S TIUX("TEXT",BN,0)=@TEMP@(BN)
D SETTEXT^TIUSRVPT(.TIUY,TIUDA,.TIUX,1)
;
; Set the Chart Review with provider, dx and note
I MORE D
. K APCDALVR
. S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
. S APCDALVR("APCDTPS")="PRIMARY",APCDALVR("APCDTPRO")=$P(^VA(200,DUZ,0),U,1)
. S APCDALVR("APCDPAT")=BTPWDFN,APCDALVR("APCDVSIT")=BTPWVIEN
. S RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
. ;
. K APCDALVR
. S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
. S AUPNS=107728002
. S APCDALVR("APCDTPOV")=$S($G(APCDCAT)="T":"Z71.9",1:$$CRPOV^BTPWPBTH())
. S APCDALVR("APCDTPS")="PRIMARY"
. S APCDALVR("APCDTNQ")=$S($G(APCDCAT)="T":"iCare Telephone Note|185317003",1:"iCare Chart Review|107728002")
. S APCDALVR("APCDPAT")=BTPWDFN,APCDALVR("APCDVSIT")=BTPWVIEN
. S RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
. ;
. K APCDALVR
. S APCDALVR("APCDATMP")="[APCDALVR 9000010.28 (ADD)]"
. S APCDALVR("APCDTDOC")=TIUDA
. S APCDALVR("APCDPAT")=BTPWDFN,APCDALVR("APCDVSIT")=BTPWVIEN
. S RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
. ;
S RESULT=1
;
DONE ;
K @TEMP
S @NDATA@(II)="T00001RESULT^T01024MSG^I00010BTPWVIEN^I00010TIUDA"_$C(30)
S II=II+1,@NDATA@(II)=RESULT_U_U_$G(BTPWVIEN)_U_$G(TIUDA)_$C(30)
S II=II+1,@NDATA@(II)=$C(31)
Q
;
NAR(TEXT) ; EP
NEW SOURCE,VALUE,DIC,DLAYGO,X,Y,IEN
S DIC(0)="LX",DIC="^AUTNPOV(",DLAYGO=9999999.27,X=TEXT
D ^DIC
S IEN=+Y
I IEN=-1 K DO,DD D FILE^DICN S IEN=+Y
Q IEN
;
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,@NDATA@(II)=$C(31)
Q
;
TXT(NDATA,TLIST) ; EP -- BTPW GET NOTE TEXT
NEW UID,II,LIST,BN,BTP,TIUDA,HSTEXT
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 II=0
;
S NDATA=$NA(^TMP("BTPWNTTXT",UID)) K @NDATA
S @NDATA@(II)="T01024REPORT_TEXT"_$C(30)
;
I $D(TLIST)>1 D
. S LIST="",BN=""
. F S BN=$O(TLIST(BN)) Q:BN="" S LIST=LIST_TLIST(BN)
. K TLIST S TLIST=LIST
;
F BTP=1:1 S TIUDA=$P(TLIST,$C(28),BTP) Q:TIUDA="" D
. ;D TGET^TIUSRVR1(.DATA,TIUDA)
. D GET^BQITIUTX(.DATA,TIUDA)
. S BN=$S($G(@DATA@(1))["TITLE:":6,1:0)
. F S BN=$O(@DATA@(BN)) Q:BN="" D
.. S HSTEXT=@DATA@(BN)
.. S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^"),HSTEXT=$$CTRL^BQIUL1(HSTEXT)
.. S II=II+1,@NDATA@(II)=HSTEXT_$C(10)
. S II=II+1,@NDATA@(II)=$C(12)
S II=II+1,@NDATA@(II)=$C(30)
S II=II+1,@NDATA@(II)=$C(31)
K @DATA
Q
BTPWTINT ;VNGT/HS/ALA-TIU Note Text ; 28 Mar 2010 6:59 PM
+1 ;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17
+2 ;
+3 ;
EN(NDATA,BTPWDFN,BTPWVIEN,BTPWTIT,SUBJ,SIGN,TIUDA,BTPWNOT,TEXT) ; EP - BTPW SET NOTE
+1 ; Input
+2 ; BTPWDFN = Patient IEN
+3 ; BTPWVIEN = Visit IEN
+4 ; BTPWTIT = Document Title IEN
+5 ; SUBJ = Subject header
+6 ; SIGN = Electronic Signature
+7 ; TIUDA = Existing Note IEN
+8 ; BTPWNOT = Notification type
+9 ; TEXT = Note text
+10 ;
+11 NEW II,UID,MORE,BN,LINE,CT,NBN
+12 ; Create chart review visit
+13 ; BTPWVIEN = Visit IEN
+14 SET II=0
+15 ;
+16 ; SAC 2006 2.2.3
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTINT D UNWIND^%ZTER"
+17 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+18 SET NDATA=$NAME(^TMP("BTPWTINT",UID))
SET TEMP=$NAME(^TMP("BTPWNOTE",UID))
+19 KILL @NDATA,@TEMP
+20 ;
+21 IF $DATA(TEXT)>1
Begin DoDot:1
+22 SET BN=""
SET LINE=""
SET CT=0
+23 FOR
SET BN=$ORDER(TEXT(BN))
IF BN=""
QUIT
Begin DoDot:2
+24 SET NBN=$ORDER(TEXT(BN))
+25 SET LINE=LINE_TEXT(BN)
IF NBN'=""
SET LINE=LINE_TEXT(NBN)
+26 IF NBN'=""
Begin DoDot:3
+27 FOR BQ=1:1:$LENGTH(LINE,$CHAR(10))-1
SET CT=CT+1
SET @TEMP@(CT)=$PIECE(LINE,$CHAR(10),BQ)
+28 SET LINE=$PIECE(LINE,$CHAR(10),BQ+1,$LENGTH(LINE,$CHAR(10)))
+29 SET BN=NBN
End DoDot:3
+30 IF NBN=""
Begin DoDot:3
+31 FOR BQ=1:1:$LENGTH(LINE,$CHAR(10))
SET CT=CT+1
SET @TEMP@(CT)=$PIECE(LINE,$CHAR(10),BQ)
End DoDot:3
End DoDot:2
End DoDot:1
+32 IF $DATA(TEXT)=1
Begin DoDot:1
+33 SET LINE=TEXT
SET CT=0
+34 FOR BQ=1:1:$LENGTH(LINE,$CHAR(10))
SET CT=CT+1
SET @TEMP@(CT)=$PIECE(LINE,$CHAR(10),BQ)
End DoDot:1
+35 ;
+36 IF $GET(TIUDA)'=""
Begin DoDot:1
+37 NEW TIUX,BN,RESULT,MSG,ERROR
+38 KILL TIUX
+39 SET TIUX("HDR")="1^1"
+40 SET BN=0
FOR
SET BN=$ORDER(@TEMP@(BN))
IF BN=""
QUIT
SET TIUX("TEXT",BN,0)=@TEMP@(BN)
+41 DO UPDATE^TIUSRVP(.ERROR,TIUDA,.TIUX,1)
+42 SET RESULT=1
SET MSG=""
+43 IF $PIECE($GET(ERROR),U,1)=0
SET RESULT=-1
SET MSG=$PIECE($GET(ERROR),U,2)
+44 SET @NDATA@(II)="I00010RESULT^T00080MESSAGE^I00010BTPWVIEN^I00010TIUDA"_$CHAR(30)
+45 SET II=II+1
SET @NDATA@(II)=RESULT_U_MSG_U_BTPWVIEN_U_TIUDA_$CHAR(30)
+46 SET II=II+1
SET @NDATA@(II)=$CHAR(31)
+47 KILL @TEMP
End DoDot:1
QUIT
+48 ;
+49 SET MORE=$SELECT($GET(BTPWVIEN)'="":"",1:1)
+50 SET NOTTYP=$SELECT($GET(BTPWNOT)="P":4,$GET(BTPWNOT)="L":1,1:$GET(BTPWNOT))
+51 SET APCDCAT=$SELECT($GET(BTPWNOT)=4:"T",$GET(BTPWNOT)="P":"T",1:"C")
+52 ;
+53 ; Create Chart Review
+54 IF $GET(BTPWVIEN)=""
Begin DoDot:1
+55 SET BTPWVIEN=$$EN^BTPWPCHT($GET(NOTTYP),BTPWDFN,1)
End DoDot:1
+56 IF BTPWVIEN=-1
Begin DoDot:1
+57 SET @NDATA@(II)="I00010RESULT^T00080MESSAGE^I00010BTPWVIEN"_$CHAR(30)
+58 SET II=II+1
SET @NDATA@(II)="-1^Unable to create Visit Record^"_$CHAR(30)
+59 SET II=II+1
SET @NDATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+60 ; Get visit data
+61 NEW TIUDA,N,BTPWVIS,TIUX,RESULT
+62 SET DATA="BTPWVIS"
+63 DO LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
+64 ;
+65 IF $GET(SUBJ)=""
SET SUBJ="CMET Notification"
+66 ;
+67 SET N=0
+68 FOR
SET N=$ORDER(BTPWVIS(N))
IF N=""
QUIT
Begin DoDot:1
+69 IF $PIECE(BTPWVIS(N),U,1)="VST"
IF $PIECE(BTPWVIS(N),U,2)="HL"
SET TIUX(1205)=$PIECE(BTPWVIS(4),U,3)
QUIT
+70 IF $PIECE(BTPWVIS(N),U,1)="HDR"
SET VSTR=$PIECE(BTPWVIS(N),U,4)
End DoDot:1
+71 SET TIUX(1202)=DUZ
+72 SET TIUX(1301)=$$NOW^XLFDT()
+73 ; Subject (may need to be passed)
+74 SET TIUX(1701)=SUBJ
+75 SET TIUX("VISIT")=BTPWVIEN
+76 ; Create TIU record
+77 DO MAKE^TIUSRVP(.RESULT,BTPWDFN,BTPWTIT,"","",BTPWVIEN,.TIUX,"",1,"")
+78 SET TIUDA=RESULT
+79 ; Save document RPC - TIU SET DOCUMENT TEXT
+80 ; TIUX("HDR")=<# of Current Page>^<Total # of Pages>
+81 ; TIUX("TEXT",1,0)=<Line 1 of document body>
+82 ; TIUX("TEXT",2,0)=<Line 2 of document body>
+83 ; TIUX("TEXT",3,0)=<Line 3 of document body>
+84 KILL TIUX
+85 SET TIUX("HDR")="1^1"
+86 SET BN=0
FOR
SET BN=$ORDER(@TEMP@(BN))
IF BN=""
QUIT
SET TIUX("TEXT",BN,0)=@TEMP@(BN)
+87 DO SETTEXT^TIUSRVPT(.TIUY,TIUDA,.TIUX,1)
+88 ;
+89 ; Set the Chart Review with provider, dx and note
+90 IF MORE
Begin DoDot:1
+91 KILL APCDALVR
+92 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
+93 SET APCDALVR("APCDTPS")="PRIMARY"
SET APCDALVR("APCDTPRO")=$PIECE(^VA(200,DUZ,0),U,1)
+94 SET APCDALVR("APCDPAT")=BTPWDFN
SET APCDALVR("APCDVSIT")=BTPWVIEN
+95 SET RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
+96 ;
+97 KILL APCDALVR
+98 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
+99 SET AUPNS=107728002
+100 SET APCDALVR("APCDTPOV")=$SELECT($GET(APCDCAT)="T":"Z71.9",1:$$CRPOV^BTPWPBTH())
+101 SET APCDALVR("APCDTPS")="PRIMARY"
+102 SET APCDALVR("APCDTNQ")=$SELECT($GET(APCDCAT)="T":"iCare Telephone Note|185317003",1:"iCare Chart Review|107728002")
+103 SET APCDALVR("APCDPAT")=BTPWDFN
SET APCDALVR("APCDVSIT")=BTPWVIEN
+104 SET RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
+105 ;
+106 KILL APCDALVR
+107 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.28 (ADD)]"
+108 SET APCDALVR("APCDTDOC")=TIUDA
+109 SET APCDALVR("APCDPAT")=BTPWDFN
SET APCDALVR("APCDVSIT")=BTPWVIEN
+110 SET RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
+111 ;
End DoDot:1
+112 SET RESULT=1
+113 ;
DONE ;
+1 KILL @TEMP
+2 SET @NDATA@(II)="T00001RESULT^T01024MSG^I00010BTPWVIEN^I00010TIUDA"_$CHAR(30)
+3 SET II=II+1
SET @NDATA@(II)=RESULT_U_U_$GET(BTPWVIEN)_U_$GET(TIUDA)_$CHAR(30)
+4 SET II=II+1
SET @NDATA@(II)=$CHAR(31)
+5 QUIT
+6 ;
NAR(TEXT) ; EP
+1 NEW SOURCE,VALUE,DIC,DLAYGO,X,Y,IEN
+2 SET DIC(0)="LX"
SET DIC="^AUTNPOV("
SET DLAYGO=9999999.27
SET X=TEXT
+3 DO ^DIC
+4 SET IEN=+Y
+5 IF IEN=-1
KILL DO,DD
DO FILE^DICN
SET IEN=+Y
+6 QUIT IEN
+7 ;
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 @NDATA@(II)=$CHAR(31)
+7 QUIT
+8 ;
TXT(NDATA,TLIST) ; EP -- BTPW GET NOTE TEXT
+1 NEW UID,II,LIST,BN,BTP,TIUDA,HSTEXT
+2 ; SAC 2006 2.2.3
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTINT D UNWIND^%ZTER"
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET II=0
+5 ;
+6 SET NDATA=$NAME(^TMP("BTPWNTTXT",UID))
KILL @NDATA
+7 SET @NDATA@(II)="T01024REPORT_TEXT"_$CHAR(30)
+8 ;
+9 IF $DATA(TLIST)>1
Begin DoDot:1
+10 SET LIST=""
SET BN=""
+11 FOR
SET BN=$ORDER(TLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_TLIST(BN)
+12 KILL TLIST
SET TLIST=LIST
End DoDot:1
+13 ;
+14 FOR BTP=1:1
SET TIUDA=$PIECE(TLIST,$CHAR(28),BTP)
IF TIUDA=""
QUIT
Begin DoDot:1
+15 ;D TGET^TIUSRVR1(.DATA,TIUDA)
+16 DO GET^BQITIUTX(.DATA,TIUDA)
+17 SET BN=$SELECT($GET(@DATA@(1))["TITLE:":6,1:0)
+18 FOR
SET BN=$ORDER(@DATA@(BN))
IF BN=""
QUIT
Begin DoDot:2
+19 SET HSTEXT=@DATA@(BN)
+20 SET HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
SET HSTEXT=$$CTRL^BQIUL1(HSTEXT)
+21 SET II=II+1
SET @NDATA@(II)=HSTEXT_$CHAR(10)
End DoDot:2
+22 SET II=II+1
SET @NDATA@(II)=$CHAR(12)
End DoDot:1
+23 SET II=II+1
SET @NDATA@(II)=$CHAR(30)
+24 SET II=II+1
SET @NDATA@(II)=$CHAR(31)
+25 KILL @DATA
+26 QUIT
