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

BTPWPBTH.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1.  ;
  1. EN(NDATA,BTPWDFN,BTPWVIEN,BTPWTIT,SUBJ,SIGN,BTPWNOT,TEXT) ; EP - BTPW BATCH NOTES
  1.  ; Input
  1.  ;   BTPWDFN  = Patient IEN
  1.  ;   BTPWVIEN = Visit IEN
  1.  ;   BTPWTIT  = Document Title IEN
  1.  ;   SUBJ     = Subject header
  1.  ;   SIGN     = Electronic Signature
  1.  ;   BTPWNOT  = Notification Type
  1.  ;   TEXT     = Note text
  1.  ;
  1.  ; Create chart review visit
  1.  ;   BTPWVIEN = Visit IEN
  1.  S II=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPBTH D UNWIND^%ZTER" ; SAC 2006 2.2.3
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S NDATA=$NA(^TMP("BTPWPBTH",UID)),TEMP=$NA(^TMP("BTPWNOTE",UID))
  1.  K @NDATA,@TEMP
  1.  ;
  1.  I $D(TEXT)>1 D
  1.  . S BN="",LINE="",CT=0
  1.  . F  S BN=$O(TEXT(BN)) Q:BN=""  D
  1.  .. S NBN=$O(TEXT(BN))
  1.  .. S LINE=LINE_TEXT(BN) I NBN'="" S LINE=LINE_TEXT(NBN)
  1.  .. I NBN'="" D
  1.  ... F BQ=1:1:$L(LINE,$C(10))-1 S CT=CT+1,@TEMP@(CT)=$P(LINE,$C(10),BQ)
  1.  ... S LINE=$P(LINE,$C(10),BQ+1,$L(LINE,$C(10)))
  1.  ... S BN=NBN
  1.  .. I NBN="" D
  1.  ... F BQ=1:1:$L(LINE,$C(10)) S CT=CT+1,@TEMP@(CT)=$P(LINE,$C(10),BQ)
  1.  I $D(TEXT)=1 D
  1.  . S LINE=TEXT,CT=0
  1.  . F BQ=1:1:$L(LINE,$C(10)) S CT=CT+1,@TEMP@(CT)=$P(LINE,$C(10),BQ)
  1.  ;
  1.  NEW NOTTYP
  1.  S NOTTYP=$S($G(BTPWNOT)="P":4,$G(BTPWNOT)="L":1,1:$G(BTPWNOT))
  1.  S APCDCAT=$S($G(BTPWNOT)=4:"T",$G(BTPWNOT)="P":"T",1:"C")
  1.  ; Create Chart Review
  1.  I $G(BTPWVIEN)="" D
  1.  . S BTPWVIEN=$$EN^BTPWPCHT($G(NOTTYP),BTPWDFN,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.  ; Get visit data
  1.  NEW TIUDA,N,BTPWVIS,TIUX,RESULT
  1.  S DATA="BTPWVIS"
  1.  D LOAD^BEHOENP1(.DATA,BTPWDFN,BTPWVIEN)
  1.  ;
  1.  I $G(SUBJ)="" S SUBJ="CMET Batch Notification"
  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.  S TIUX(1701)=SUBJ
  1.  S TIUX("VISIT")=BTPWVIEN
  1.  ;
  1.  ; Create TIU record
  1.  D MAKE^TIUSRVP(.RESULT,BTPWDFN,BTPWTIT,"","",BTPWVIEN,.TIUX,"",1,"")
  1.  S TIUDA=RESULT
  1.  ; Save document RPC - TIU SET DOCUMENT TEXT
  1.  ;                TIUX("HDR")=<# of Current Page>^<Total # of Pages>
  1.  ;                TIUX("TEXT",1,0)=<Line 1 of document body>
  1.  ;                TIUX("TEXT",2,0)=<Line 2 of document body>
  1.  ;                TIUX("TEXT",3,0)=<Line 3 of document body>
  1.  ; Update the text for the patient
  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 TIUX
  1.  S BN=0 F  S BN=$O(@TEMP@(BN)) Q:BN=""  S TIUX(BN,0)=@TEMP@(BN)
  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.  K TIUZ
  1.  M TIUZ=@TIUY
  1.  K TIUX
  1.  S TIUX("HDR")="1^1"
  1.  S BN=0 F  S BN=$O(TIUZ(BN)) Q:BN=""  S TIUX("TEXT",BN,0)=TIUZ(BN,0)
  1.  D SETTEXT^TIUSRVPT(.TIUY,TIUDA,.TIUX,1)
  1.  ;
  1.  ; Set the Visit with provider, dx and note
  1.  K APCDALVR
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
  1.  S APCDALVR("APCDTPS")="PRIMARY"
  1.  S APCDALVR("APCDTPRO")=$P(^VA(200,DUZ,0),U,1)
  1.  ;S APCDALVR("APCDTPRO")=DUZ
  1.  S APCDALVR("APCDPAT")=BTPWDFN,APCDALVR("APCDVSIT")=BTPWVIEN
  1.  S RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
  1.  ;
  1.  K APCDALVR
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
  1.  S APCDALVR("APCDTPOV")=$S($G(APCDCAT)="T":"Z71.9",1:$$CRPOV^BTPWPBTH())
  1.  S APCDALVR("APCDTPS")="PRIMARY"
  1.  S APCDALVR("APCDTNQ")=$S($G(APCDCAT)="T":"iCare Telephone Note|185317003",1:"iCare Chart Review|107728002")
  1.  S APCDALVR("APCDPAT")=BTPWDFN,APCDALVR("APCDVSIT")=BTPWVIEN
  1.  S RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
  1.  ;
  1.  K APCDALVR
  1.  D EN1^APCDEKL
  1.  I $O(^AUPNVNOT("B",TIUDA,""))="" D
  1.  . S APCDALVR("APCDATMP")="[APCDALVR 9000010.28 (ADD)]"
  1.  . S APCDALVR("APCDTDOC")=TIUDA
  1.  . S APCDALVR("APCDPAT")=BTPWDFN,APCDALVR("APCDVSIT")=BTPWVIEN
  1.  . S RESULT=$$ADD^BTPWPCHT(BTPWDFN,BTPWVIEN,.APCDALVR)
  1.  ;
  1.  D EN1^APCDEKL
  1.  K @TEMP
  1.  S @NDATA@(II)="T00001RESULT^T01024MSG^I00010BTPWVIEN^I00010TIUDA"_$C(30)
  1.  S II=II+1,@NDATA@(II)=1_U_U_BTPWVIEN_U_TIUDA_$C(30)
  1.  S II=II+1,@NDATA@(II)=$C(31)
  1.  Q
  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,@NDATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CRPOV() ;PEP - Return valid chart review code
  1.  NEW TAX,TREF,BQN,BQCODE
  1.  S TREF="BQITAX" K @TREF
  1.  S TAX="BQI CHART REVIEW DXS" D BLD^BQITUTL(TAX,.TREF)
  1.  I '$D(@TREF) Q "V68.9"
  1.  S BQN=""
  1.  F  S BQN=$O(@TREF@(BQN)) Q:BQN=""  D
  1.  . I $$VERSION^XPDUTL("AICD")<4.0 D  Q
  1.  .. I $P(@TREF@(BQN),U,4)="ICD-9-CM" S BQCODE=$P(@TREF@(BQN),U,1)
  1.  . I $$VERSION^XPDUTL("AICD")>3.51 D
  1.  .. I DT<$$IMP^ICDEXA(30) D  Q
  1.  ... I $P(@TREF@(BQN),U,4)="ICD-9-CM" S BQCODE=$P(@TREF@(BQN),U,1)
  1.  .. I $P(@TREF@(BQN),U,4)="ICD-10-CM" S BQCODE=$P(@TREF@(BQN),U,1)
  1.  Q BQCODE