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

BTPWTINT.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. EN(NDATA,BTPWDFN,BTPWVIEN,BTPWTIT,SUBJ,SIGN,TIUDA,BTPWNOT,TEXT) ; EP - BTPW SET NOTE
  1. ; Input
  1. ; BTPWDFN = Patient IEN
  1. ; BTPWVIEN = Visit IEN
  1. ; BTPWTIT = Document Title IEN
  1. ; SUBJ = Subject header
  1. ; SIGN = Electronic Signature
  1. ; TIUDA = Existing Note IEN
  1. ; BTPWNOT = Notification type
  1. ; TEXT = Note text
  1. ;
  1. NEW II,UID,MORE,BN,LINE,CT,NBN
  1. ; Create chart review visit
  1. ; BTPWVIEN = Visit IEN
  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("BTPWTINT",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. I $G(TIUDA)'="" D Q
  1. . NEW TIUX,BN,RESULT,MSG,ERROR
  1. . K TIUX
  1. . S TIUX("HDR")="1^1"
  1. . S BN=0 F S BN=$O(@TEMP@(BN)) Q:BN="" S TIUX("TEXT",BN,0)=@TEMP@(BN)
  1. . D UPDATE^TIUSRVP(.ERROR,TIUDA,.TIUX,1)
  1. . S RESULT=1,MSG=""
  1. . I $P($G(ERROR),U,1)=0 S RESULT=-1,MSG=$P($G(ERROR),U,2)
  1. . S @NDATA@(II)="I00010RESULT^T00080MESSAGE^I00010BTPWVIEN^I00010TIUDA"_$C(30)
  1. . S II=II+1,@NDATA@(II)=RESULT_U_MSG_U_BTPWVIEN_U_TIUDA_$C(30)
  1. . S II=II+1,@NDATA@(II)=$C(31)
  1. . K @TEMP
  1. ;
  1. S MORE=$S($G(BTPWVIEN)'="":"",1:1)
  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. ;
  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^I00010BTPWVIEN"_$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 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. ; 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. K TIUX
  1. S TIUX("HDR")="1^1"
  1. S BN=0 F S BN=$O(@TEMP@(BN)) Q:BN="" S TIUX("TEXT",BN,0)=@TEMP@(BN)
  1. D SETTEXT^TIUSRVPT(.TIUY,TIUDA,.TIUX,1)
  1. ;
  1. ; Set the Chart Review with provider, dx and note
  1. I MORE D
  1. . K APCDALVR
  1. . S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
  1. . S APCDALVR("APCDTPS")="PRIMARY",APCDALVR("APCDTPRO")=$P(^VA(200,DUZ,0),U,1)
  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 AUPNS=107728002
  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. . 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. S RESULT=1
  1. ;
  1. DONE ;
  1. K @TEMP
  1. S @NDATA@(II)="T00001RESULT^T01024MSG^I00010BTPWVIEN^I00010TIUDA"_$C(30)
  1. S II=II+1,@NDATA@(II)=RESULT_U_U_$G(BTPWVIEN)_U_$G(TIUDA)_$C(30)
  1. S II=II+1,@NDATA@(II)=$C(31)
  1. Q
  1. ;
  1. NAR(TEXT) ; EP
  1. NEW SOURCE,VALUE,DIC,DLAYGO,X,Y,IEN
  1. S DIC(0)="LX",DIC="^AUTNPOV(",DLAYGO=9999999.27,X=TEXT
  1. D ^DIC
  1. S IEN=+Y
  1. I IEN=-1 K DO,DD D FILE^DICN S IEN=+Y
  1. Q IEN
  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. TXT(NDATA,TLIST) ; EP -- BTPW GET NOTE TEXT
  1. NEW UID,II,LIST,BN,BTP,TIUDA,HSTEXT
  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 II=0
  1. ;
  1. S NDATA=$NA(^TMP("BTPWNTTXT",UID)) K @NDATA
  1. S @NDATA@(II)="T01024REPORT_TEXT"_$C(30)
  1. ;
  1. I $D(TLIST)>1 D
  1. . S LIST="",BN=""
  1. . F S BN=$O(TLIST(BN)) Q:BN="" S LIST=LIST_TLIST(BN)
  1. . K TLIST S TLIST=LIST
  1. ;
  1. F BTP=1:1 S TIUDA=$P(TLIST,$C(28),BTP) Q:TIUDA="" D
  1. . ;D TGET^TIUSRVR1(.DATA,TIUDA)
  1. . D GET^BQITIUTX(.DATA,TIUDA)
  1. . S BN=$S($G(@DATA@(1))["TITLE:":6,1:0)
  1. . F S BN=$O(@DATA@(BN)) Q:BN="" D
  1. .. S HSTEXT=@DATA@(BN)
  1. .. S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^"),HSTEXT=$$CTRL^BQIUL1(HSTEXT)
  1. .. S II=II+1,@NDATA@(II)=HSTEXT_$C(10)
  1. . S II=II+1,@NDATA@(II)=$C(12)
  1. S II=II+1,@NDATA@(II)=$C(30)
  1. S II=II+1,@NDATA@(II)=$C(31)
  1. K @DATA
  1. Q