- 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