BTPWPBTH ;VNGT/HS/ALA-Batch Process TIU Letters ; 27 Aug 2009 3:05 PM
;;1.2;CARE MANAGEMENT EVENT TRACKING;**1**;JUL 07,2017;Build 5
;
Q
;
EN(NDATA,BTPWDFN,BTPWVIEN,BTPWTIT,SUBJ,SIGN,BTPWNOT,TEXT) ; EP - BTPW BATCH NOTES
; Input
; BTPWDFN = Patient IEN
; BTPWVIEN = Visit IEN
; BTPWTIT = Document Title IEN
; SUBJ = Subject header
; SIGN = Electronic Signature
; BTPWNOT = Notification Type
; TEXT = Note text
;
; Create chart review visit
; BTPWVIEN = Visit IEN
S II=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPBTH D UNWIND^%ZTER" ; SAC 2006 2.2.3
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S NDATA=$NA(^TMP("BTPWPBTH",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)
;
NEW NOTTYP
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^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)
; Get visit data
NEW TIUDA,N,BTPWVIS,TIUX,RESULT
S DATA="BTPWVIS"
D LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
;
I $G(SUBJ)="" S SUBJ="CMET Batch 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>
; Update the text for the patient
;K TIUX
;S I=0 F S I=$O(@TIUY@(I)) Q:I="" S TIUX(I,0)=@TIUY@(I)
; Replace boilerplate with data
K TIUX
S BN=0 F S BN=$O(@TEMP@(BN)) Q:BN="" S TIUX(BN,0)=@TEMP@(BN)
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
K TIUZ
M TIUZ=@TIUY
K TIUX
S TIUX("HDR")="1^1"
S BN=0 F S BN=$O(TIUZ(BN)) Q:BN="" S TIUX("TEXT",BN,0)=TIUZ(BN,0)
D SETTEXT^TIUSRVPT(.TIUY,TIUDA,.TIUX,1)
;
; Set the Visit with provider, dx and note
K APCDALVR
S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
S APCDALVR("APCDTPS")="PRIMARY"
S APCDALVR("APCDTPRO")=$P(^VA(200,DUZ,0),U,1)
;S APCDALVR("APCDTPRO")=DUZ
S APCDALVR("APCDPAT")=BTPWDFN,APCDALVR("APCDVSIT")=BTPWVIEN
S RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
;
K APCDALVR
S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
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
D EN1^APCDEKL
I $O(^AUPNVNOT("B",TIUDA,""))="" D
. 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)
;
D EN1^APCDEKL
K @TEMP
S @NDATA@(II)="T00001RESULT^T01024MSG^I00010BTPWVIEN^I00010TIUDA"_$C(30)
S II=II+1,@NDATA@(II)=1_U_U_BTPWVIEN_U_TIUDA_$C(30)
S II=II+1,@NDATA@(II)=$C(31)
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
S II=II+1,@NDATA@(II)=$C(31)
Q
;
CRPOV() ;PEP - Return valid chart review code
NEW TAX,TREF,BQN,BQCODE
S TREF="BQITAX" K @TREF
S TAX="BQI CHART REVIEW DXS" D BLD^BQITUTL(TAX,.TREF)
I '$D(@TREF) Q "V68.9"
S BQN=""
F S BQN=$O(@TREF@(BQN)) Q:BQN="" D
. I $$VERSION^XPDUTL("AICD")<4.0 D Q
.. I $P(@TREF@(BQN),U,4)="ICD-9-CM" S BQCODE=$P(@TREF@(BQN),U,1)
. I $$VERSION^XPDUTL("AICD")>3.51 D
.. I DT<$$IMP^ICDEXA(30) D Q
... I $P(@TREF@(BQN),U,4)="ICD-9-CM" S BQCODE=$P(@TREF@(BQN),U,1)
.. I $P(@TREF@(BQN),U,4)="ICD-10-CM" S BQCODE=$P(@TREF@(BQN),U,1)
Q BQCODE
BTPWPBTH ;VNGT/HS/ALA-Batch Process TIU Letters ; 27 Aug 2009 3:05 PM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;**1**;JUL 07,2017;Build 5
+2 ;
+3 QUIT
+4 ;
EN(NDATA,BTPWDFN,BTPWVIEN,BTPWTIT,SUBJ,SIGN,BTPWNOT,TEXT) ; EP - BTPW BATCH NOTES
+1 ; Input
+2 ; BTPWDFN = Patient IEN
+3 ; BTPWVIEN = Visit IEN
+4 ; BTPWTIT = Document Title IEN
+5 ; SUBJ = Subject header
+6 ; SIGN = Electronic Signature
+7 ; BTPWNOT = Notification Type
+8 ; TEXT = Note text
+9 ;
+10 ; Create chart review visit
+11 ; BTPWVIEN = Visit IEN
+12 SET II=0
+13 ;
+14 ; SAC 2006 2.2.3
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPBTH D UNWIND^%ZTER"
+15 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+16 SET NDATA=$NAME(^TMP("BTPWPBTH",UID))
SET TEMP=$NAME(^TMP("BTPWNOTE",UID))
+17 KILL @NDATA,@TEMP
+18 ;
+19 IF $DATA(TEXT)>1
Begin DoDot:1
+20 SET BN=""
SET LINE=""
SET CT=0
+21 FOR
SET BN=$ORDER(TEXT(BN))
IF BN=""
QUIT
Begin DoDot:2
+22 SET NBN=$ORDER(TEXT(BN))
+23 SET LINE=LINE_TEXT(BN)
IF NBN'=""
SET LINE=LINE_TEXT(NBN)
+24 IF NBN'=""
Begin DoDot:3
+25 FOR BQ=1:1:$LENGTH(LINE,$CHAR(10))-1
SET CT=CT+1
SET @TEMP@(CT)=$PIECE(LINE,$CHAR(10),BQ)
+26 SET LINE=$PIECE(LINE,$CHAR(10),BQ+1,$LENGTH(LINE,$CHAR(10)))
+27 SET BN=NBN
End DoDot:3
+28 IF NBN=""
Begin DoDot:3
+29 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
+30 IF $DATA(TEXT)=1
Begin DoDot:1
+31 SET LINE=TEXT
SET CT=0
+32 FOR BQ=1:1:$LENGTH(LINE,$CHAR(10))
SET CT=CT+1
SET @TEMP@(CT)=$PIECE(LINE,$CHAR(10),BQ)
End DoDot:1
+33 ;
+34 NEW NOTTYP
+35 SET NOTTYP=$SELECT($GET(BTPWNOT)="P":4,$GET(BTPWNOT)="L":1,1:$GET(BTPWNOT))
+36 SET APCDCAT=$SELECT($GET(BTPWNOT)=4:"T",$GET(BTPWNOT)="P":"T",1:"C")
+37 ; Create Chart Review
+38 IF $GET(BTPWVIEN)=""
Begin DoDot:1
+39 SET BTPWVIEN=$$EN^BTPWPCHT($GET(NOTTYP),BTPWDFN,1)
End DoDot:1
+40 IF BTPWVIEN=-1
Begin DoDot:1
+41 SET @NDATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$CHAR(30)
+42 SET II=II+1
SET @NDATA@(II)="-1^Unable to create Visit Record^"_$CHAR(30)
+43 SET II=II+1
SET @NDATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+44 ; Get visit data
+45 NEW TIUDA,N,BTPWVIS,TIUX,RESULT
+46 SET DATA="BTPWVIS"
+47 DO LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
+48 ;
+49 IF $GET(SUBJ)=""
SET SUBJ="CMET Batch Notification"
+50 ;
+51 SET N=0
+52 FOR
SET N=$ORDER(BTPWVIS(N))
IF N=""
QUIT
Begin DoDot:1
+53 IF $PIECE(BTPWVIS(N),U,1)="VST"
IF $PIECE(BTPWVIS(N),U,2)="HL"
SET TIUX(1205)=$PIECE(BTPWVIS(4),U,3)
QUIT
+54 IF $PIECE(BTPWVIS(N),U,1)="HDR"
SET VSTR=$PIECE(BTPWVIS(N),U,4)
End DoDot:1
+55 SET TIUX(1202)=DUZ
+56 SET TIUX(1301)=$$NOW^XLFDT()
+57 ; Subject (may need to be passed)
+58 SET TIUX(1701)=SUBJ
+59 SET TIUX("VISIT")=BTPWVIEN
+60 ;
+61 ; Create TIU record
+62 DO MAKE^TIUSRVP(.RESULT,BTPWDFN,BTPWTIT,"","",BTPWVIEN,.TIUX,"",1,"")
+63 SET TIUDA=RESULT
+64 ; Save document RPC - TIU SET DOCUMENT TEXT
+65 ; TIUX("HDR")=<# of Current Page>^<Total # of Pages>
+66 ; TIUX("TEXT",1,0)=<Line 1 of document body>
+67 ; TIUX("TEXT",2,0)=<Line 2 of document body>
+68 ; TIUX("TEXT",3,0)=<Line 3 of document body>
+69 ; Update the text for the patient
+70 ;K TIUX
+71 ;S I=0 F S I=$O(@TIUY@(I)) Q:I="" S TIUX(I,0)=@TIUY@(I)
+72 ; Replace boilerplate with data
+73 KILL TIUX
+74 SET BN=0
FOR
SET BN=$ORDER(@TEMP@(BN))
IF BN=""
QUIT
SET TIUX(BN,0)=@TEMP@(BN)
+75 KILL ^TMP("TIUBOIL",$JOB)
+76 ; Variable needs to be set for the "{FLD:} values to stay in the text
+77 SET XWBOS=1
+78 DO GETTEXT^TIUSRVT(.TIUY,BTPWDFN,VSTR,.TIUX)
+79 KILL XWBOS
+80 KILL TIUZ
+81 MERGE TIUZ=@TIUY
+82 KILL TIUX
+83 SET TIUX("HDR")="1^1"
+84 SET BN=0
FOR
SET BN=$ORDER(TIUZ(BN))
IF BN=""
QUIT
SET TIUX("TEXT",BN,0)=TIUZ(BN,0)
+85 DO SETTEXT^TIUSRVPT(.TIUY,TIUDA,.TIUX,1)
+86 ;
+87 ; Set the Visit with provider, dx and note
+88 KILL APCDALVR
+89 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
+90 SET APCDALVR("APCDTPS")="PRIMARY"
+91 SET APCDALVR("APCDTPRO")=$PIECE(^VA(200,DUZ,0),U,1)
+92 ;S APCDALVR("APCDTPRO")=DUZ
+93 SET APCDALVR("APCDPAT")=BTPWDFN
SET APCDALVR("APCDVSIT")=BTPWVIEN
+94 SET RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
+95 ;
+96 KILL APCDALVR
+97 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
+98 SET APCDALVR("APCDTPOV")=$SELECT($GET(APCDCAT)="T":"Z71.9",1:$$CRPOV^BTPWPBTH())
+99 SET APCDALVR("APCDTPS")="PRIMARY"
+100 SET APCDALVR("APCDTNQ")=$SELECT($GET(APCDCAT)="T":"iCare Telephone Note|185317003",1:"iCare Chart Review|107728002")
+101 SET APCDALVR("APCDPAT")=BTPWDFN
SET APCDALVR("APCDVSIT")=BTPWVIEN
+102 SET RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
+103 ;
+104 KILL APCDALVR
+105 DO EN1^APCDEKL
+106 IF $ORDER(^AUPNVNOT("B",TIUDA,""))=""
Begin DoDot:1
+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)
End DoDot:1
+111 ;
+112 DO EN1^APCDEKL
+113 KILL @TEMP
+114 SET @NDATA@(II)="T00001RESULT^T01024MSG^I00010BTPWVIEN^I00010TIUDA"_$CHAR(30)
+115 SET II=II+1
SET @NDATA@(II)=1_U_U_BTPWVIEN_U_TIUDA_$CHAR(30)
+116 SET II=II+1
SET @NDATA@(II)=$CHAR(31)
+117 QUIT
+118 ;
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 ;
CRPOV() ;PEP - Return valid chart review code
+1 NEW TAX,TREF,BQN,BQCODE
+2 SET TREF="BQITAX"
KILL @TREF
+3 SET TAX="BQI CHART REVIEW DXS"
DO BLD^BQITUTL(TAX,.TREF)
+4 IF '$DATA(@TREF)
QUIT "V68.9"
+5 SET BQN=""
+6 FOR
SET BQN=$ORDER(@TREF@(BQN))
IF BQN=""
QUIT
Begin DoDot:1
+7 IF $$VERSION^XPDUTL("AICD")<4.0
Begin DoDot:2
+8 IF $PIECE(@TREF@(BQN),U,4)="ICD-9-CM"
SET BQCODE=$PIECE(@TREF@(BQN),U,1)
End DoDot:2
QUIT
+9 IF $$VERSION^XPDUTL("AICD")>3.51
Begin DoDot:2
+10 IF DT<$$IMP^ICDEXA(30)
Begin DoDot:3
+11 IF $PIECE(@TREF@(BQN),U,4)="ICD-9-CM"
SET BQCODE=$PIECE(@TREF@(BQN),U,1)
End DoDot:3
QUIT
+12 IF $PIECE(@TREF@(BQN),U,4)="ICD-10-CM"
SET BQCODE=$PIECE(@TREF@(BQN),U,1)
End DoDot:2
End DoDot:1
+13 QUIT BQCODE
