BTPWPCHT ;VNGT/HS/ALA-Chart Review Creation ; 20 Apr 2010 9:33 AM
;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17
;
;
EN(NOT,DFN,MORE) ; EP - Create a chart review visit
; Input
; NOT = Notification Type
;
NEW APCDAUTO,NCLN,CLN,CNAM,APCDCAT,APCDDATE,CLIN,VTYP
S NCLN=$P(^BTPW(90622,NOT,0),U,4),MORE=$G(MORE,"")
S CLN=""
F S CLN=$O(^DIC(40.7,"C",NCLN,CLN)) Q:CLN="" S CLIN=CLN
S CNAM=$P(^DIC(40.7,CLIN,0),U,1)
;
S APCDHL=$S(NCLN=51:$P(^BQICARE(DUZ,0),U,20),NCLN=53:$P(^BQICARE(DUZ,0),U,19),1:$P(^BQICARE(DUZ,0),U,18))
D DEF(CLIN,CNAM,DFN,$G(APCDLOC),$G(APCDHL))
;
; Create visit and then update other Vfiles
D EN^APCDALV
; Check for error
I '$G(APCDALVR("APCDAFLG")) S VISIT=$G(APCDALVR("APCDVSIT"))
I $G(APCDALVR("APCDAFLG"))=2!($G(APCDALVR("APCDAFLG"))=1) S VISIT=-1
Q VISIT
;
ADD(APCDPAT,APCDVSIT,APCDALVR) ; EP
; Create V files
D EN^APCDALVR
; Check for error
I '$G(APCDALVR("APCDAFLG")) S RESULT=1
I $G(APCDALVR("APCDAFLG"))=2 S RESULT=-1
; Cleanup
K APCDALVR
Q RESULT
;
DEF(CLN,CNAM,DFN,APCDLOC,APCDHL) ; Set variables
S APCDALVR("APCDCLN")=CLN
S APCDALVR("APCDHL")=APCDHL
S APCDDATE=$$NOW^XLFDT(),APCDALVR("APCDDATE")=APCDDATE
; Get default Visit Type
S VTYP=$P($G(^APCDSITE(DUZ(2),0)),U,11) I VTYP="" S VTYP="I"
S APCDALVR("APCDTYPE")=VTYP
S APCDCAT=$S(CNAM["TELEPHONE":"T",1:"C")
S APCDALVR("APCDCAT")=APCDCAT
S APCDLOC=DUZ(2),APCDALVR("APCDLOC")=APCDLOC
S APCDALVR("APCDPAT")=DFN,APCDPAT=DFN
S APCDALVR("APCDOPT")=$$FIND1^DIC(19,"","BX","BTPWRPC","","","ERROR")
;S APCDADD=1
I $G(MORE)'="" S APCDALVR("APCDAUTO")=1,APCDAUTO=1
S APCDALVR("APCDANE")="",APCDALVR("AUPNTALK")=""
Q
;
RPC(DATA,DFN,PARMS) ; EP -- BTPW CREATE CHART REVIEW
; Input
; DFN - Patient IEN
; PARMS - Parms string
;
NEW UID,II,BTWIEN,APCDAUTO,APCDDATE,MORE,APCDALVR,NAME,PDATA,PFIEN,PTYP,VALUE,CHIEN,BQ,CNAM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWCHRT",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVNT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
S BTWIEN=$$FIND1^DIC(90506.3,"","BX","Chart Review","","","ERROR")
I BTWIEN=0 D Q
. S II=II+1,@DATA@(II)="-1^RPC Failed: Passed in window name "_DEF_" not found^"_$C(30)
. S II=II+1,@DATA@(II)=$C(31)
;
S FILE=$P(^BQI(90506.3,BTWIEN,0),U,2)
S PARMS=$G(PARMS,"")
I PARMS="" D
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
. K LIST
;
K APCDALVR
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
. S PFIEN=$O(^BQI(90506.3,BTWIEN,10,"AC",NAME,""))
. I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
. S PTYP=$P($G(^BQI(90506.3,BTWIEN,10,PFIEN,1)),U,1)
. I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
. I PTYP="C"!(PTYP="K") D
.. I VALUE="" Q
.. S CHIEN=$O(^BQI(90506.3,BTWIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
.. S VALUE=$P(^BQI(90506.3,BTWIEN,10,PFIEN,5,CHIEN,0),U,2)
. I PTYP="W" K BTPWP D Q
.. F BTI=1:1 S BTJ=$P(VALUE,$C(10),BTI) Q:BTJ="" D
... S BTWP(BTI,0)=BTJ
. S @NAME=VALUE
. S APCDALVR(NAME)=VALUE
;
I $G(BTPWVIEN)'="" D Q
. S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
. I $G(TIUDA)'="" S VISIT=BTPWVIEN D NOT
. S II=II+1,@DATA@(II)="1^^"_BTPWVIEN_$C(30)
. S II=II+1,@DATA@(II)=$C(31)
. D CLNUP(BTWIEN)
;
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1)
. S PFIEN=$O(^BQI(90506.3,BTWIEN,10,"AC",NAME,""))
. I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
. S FIELD=$P($G(^BQI(90506.3,BTWIEN,10,PFIEN,3)),U,1)
. S EXEC=$G(^BQI(90506.3,BTWIEN,10,PFIEN,7))
. I EXEC'="" X EXEC Q
. I FIELD="" Q
S MORE=1
S APCDDATE=$$NOW^XLFDT(),APCDALVR("APCDDATE")=APCDDATE
S APCDALVR("APCDPAT")=DFN,APCDPAT=DFN
S APCDALVR("APCDANE")="",APCDALVR("AUPNTALK")=""
S APCDALVR("APCDLOC")=$S($G(APCDALVR("APCDLOC"))'="":APCDALVR("APCDLOC"),1:DUZ(2))
S APCDALVR("APCDTYPE")=$G(APCDALVR("APCDTYPE"),"I")
S CLN=APCDALVR("APCDCLN")
S APCDHL=$S(CLN=51:$P(^BQICARE(DUZ,0),U,20),CLN=53:$P(^BQICARE(DUZ,0),U,19),1:$P(^BQICARE(DUZ,0),U,18))
S APCDALVR("APCDHL")=APCDHL
S CLN=$O(^DIC(40.7,"C",CLN,"")),APCDALVR("APCDCLN")=CLN
S CNAM=$P(^DIC(40.7,CLN,0),U,1)
S APCDALVR("APCDOPT")=$$FIND1^DIC(19,"","BX","BTPWRPC","","","ERROR")
S APCDALVR("APCDCAT")=$S(CNAM["TELEPHONE":"T",1:"C")
I $G(MORE)'="" S APCDALVR("APCDAUTO")=1
;
; Create visit and then update other Vfiles
D EN^APCDALV
; Check for error
I '$G(APCDALVR("APCDAFLG")) S VISIT=$G(APCDALVR("APCDVSIT"))
I $G(APCDALVR("APCDAFLG"))=2 S VISIT=-1,MSG="Unable to create chart review"
I $G(APCDALVR("APCDAFLG"))=1 S VISIT=-1,MSG="Chart review already exists"
I VISIT=-1 D Q
. S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
. S II=II+1,@DATA@(II)="-1^"_MSG_"^"_$C(30)
. S II=II+1,@DATA@(II)=$C(31)
;
; Set the Chart Review with provider
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")=DFN,APCDALVR("APCDVSIT")=VISIT
S RESULT=$$ADD(DFN,VISIT,.APCDALVR)
;
; Note
I $G(TIUDA)'="" D NOT
;
;POV
K APCDALVR
NEW APCDCAT,IEN
S APCDCAT=$P(^AUPNVSIT(VISIT,0),"^",7)
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")=DFN,APCDALVR("APCDVSIT")=VISIT
S RESULT=$$ADD(DFN,VISIT,.APCDALVR)
S IEN=$O(^AUPNVPOV("AD",VISIT,""))
S BQIUPD(9000010.07,IEN_",",1101)=$S($G(APCDCAT)="T":185317003,1:107728002)
S BQIUPD(9000010.07,IEN_",",1102)=$S($G(APCDCAT)="T":285327012,1:202356017)
D FILE^DIE("","BQIUPD","ERROR")
;
S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
S II=II+1,@DATA@(II)="1^^"_VISIT_$C(30)
S II=II+1,@DATA@(II)=$C(31)
D CLNUP(BTWIEN)
Q
;
NOT ;Note
K APCDALVR
S APCDALVR("APCDATMP")="[APCDALVR 9000010.28 (ADD)]"
S APCDALVR("APCDTDOC")=TIUDA
S APCDALVR("APCDPAT")=DFN,APCDALVR("APCDVSIT")=VISIT
S RESULT=$$ADD(DFN,VISIT,.APCDALVR)
Q
;
TRIG(DATA,APCDCLN) ;EP -- BTPW CHART REVIEW TRIGGER
NEW UID,II,VALUE,SOURCE,TYPE,ABLE,CLEAR,CLFLG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWCHTR",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWBTTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T00001CLEAR_FLAG^T00060CLEAR_FIELDS^T01024PARMS"_$C(30)
I APCDCLN=51 S VALUE="T"_$C(28)_"TELEPHONE"
I APCDCLN'=51 S VALUE="C"_$C(28)_"CHART REVIEW"
S SOURCE="APCDCAT",TYPE="C",ABLE="Y",CLEAR="",CLFLG="N" D UP
S VALUE=""
I APCDCLN=51 S VALUE=$P(^BQICARE(DUZ,0),U,20) I VALUE'="" S VALUE=VALUE_$C(28)_$P(^SC(VALUE,0),U,1)
I APCDCLN=52 S VALUE=$P(^BQICARE(DUZ,0),U,18) I VALUE'="" S VALUE=VALUE_$C(28)_$P(^SC(VALUE,0),U,1)
I APCDCLN=53 S VALUE=$P(^BQICARE(DUZ,0),U,19) I VALUE'="" S VALUE=VALUE_$C(28)_$P(^SC(VALUE,0),U,1)
S SOURCE="APCDHL",TYPE="T",ABLE="Y",CLEAR="" D UP
I APCDCLN=51 S VALUE="iCare Telephone Note"
I APCDCLN'=51 S VALUE="iCare Chart Review"
S SOURCE="APCDTNQ",TYPE="T",ABLE="Y",CLEAR="" D UP
Q
;
UP ; Update
S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_$G(ABLE)_U_CLFLG_U_$G(CLEAR)_U_VALUE_$C(30)
Q
;
DEL(DATA,VISIT) ;EP -- BTPW DELETE CHART REVIEW
NEW UID,II,APCDVDLT,USER,TO,FROM,DIK,DA,RESULT,DUSR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWDCHRT",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVNT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
S RESULT="1^^"
I $O(^TIU(8925,"V",VISIT,""))'="" S RESULT="-1^TIU Document points to this visit. Cannot be deleted.^" G DONE
X ^BTPW(90628,1,3)
X DUSR X TO
S DIK="^AUPNVPOV(",DA=$O(^AUPNVPOV("AD",VISIT,"")) I DA'="" D ^DIK
S DIK="^AUPNVPRV(",DA=$O(^AUPNVPRV("AD",VISIT,"")) I DA'="" D ^DIK
S DIK="^AUPNVNOT(",DA=$O(^AUPNVNOT("AD",VISIT,"")) I DA'="" D ^DIK
S DIK="^AUPNVSIT(",DA=VISIT D ^DIK
X FROM
;
DONE ;
S II=II+1,@DATA@(II)=RESULT_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
CLNUP(VFIEN) ; Clean up variables
NEW NAME
S NAME=""
F S NAME=$O(^BQI(90506.3,VFIEN,10,"AC",NAME)) Q:NAME="" K @NAME
Q
BTPWPCHT ;VNGT/HS/ALA-Chart Review Creation ; 20 Apr 2010 9:33 AM
+1 ;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17
+2 ;
+3 ;
EN(NOT,DFN,MORE) ; EP - Create a chart review visit
+1 ; Input
+2 ; NOT = Notification Type
+3 ;
+4 NEW APCDAUTO,NCLN,CLN,CNAM,APCDCAT,APCDDATE,CLIN,VTYP
+5 SET NCLN=$PIECE(^BTPW(90622,NOT,0),U,4)
SET MORE=$GET(MORE,"")
+6 SET CLN=""
+7 FOR
SET CLN=$ORDER(^DIC(40.7,"C",NCLN,CLN))
IF CLN=""
QUIT
SET CLIN=CLN
+8 SET CNAM=$PIECE(^DIC(40.7,CLIN,0),U,1)
+9 ;
+10 SET APCDHL=$SELECT(NCLN=51:$PIECE(^BQICARE(DUZ,0),U,20),NCLN=53:$PIECE(^BQICARE(DUZ,0),U,19),1:$PIECE(^BQICARE(DUZ,0),U,18))
+11 DO DEF(CLIN,CNAM,DFN,$GET(APCDLOC),$GET(APCDHL))
+12 ;
+13 ; Create visit and then update other Vfiles
+14 DO EN^APCDALV
+15 ; Check for error
+16 IF '$GET(APCDALVR("APCDAFLG"))
SET VISIT=$GET(APCDALVR("APCDVSIT"))
+17 IF $GET(APCDALVR("APCDAFLG"))=2!($GET(APCDALVR("APCDAFLG"))=1)
SET VISIT=-1
+18 QUIT VISIT
+19 ;
ADD(APCDPAT,APCDVSIT,APCDALVR) ; EP
+1 ; Create V files
+2 DO EN^APCDALVR
+3 ; Check for error
+4 IF '$GET(APCDALVR("APCDAFLG"))
SET RESULT=1
+5 IF $GET(APCDALVR("APCDAFLG"))=2
SET RESULT=-1
+6 ; Cleanup
+7 KILL APCDALVR
+8 QUIT RESULT
+9 ;
DEF(CLN,CNAM,DFN,APCDLOC,APCDHL) ; Set variables
+1 SET APCDALVR("APCDCLN")=CLN
+2 SET APCDALVR("APCDHL")=APCDHL
+3 SET APCDDATE=$$NOW^XLFDT()
SET APCDALVR("APCDDATE")=APCDDATE
+4 ; Get default Visit Type
+5 SET VTYP=$PIECE($GET(^APCDSITE(DUZ(2),0)),U,11)
IF VTYP=""
SET VTYP="I"
+6 SET APCDALVR("APCDTYPE")=VTYP
+7 SET APCDCAT=$SELECT(CNAM["TELEPHONE":"T",1:"C")
+8 SET APCDALVR("APCDCAT")=APCDCAT
+9 SET APCDLOC=DUZ(2)
SET APCDALVR("APCDLOC")=APCDLOC
+10 SET APCDALVR("APCDPAT")=DFN
SET APCDPAT=DFN
+11 SET APCDALVR("APCDOPT")=$$FIND1^DIC(19,"","BX","BTPWRPC","","","ERROR")
+12 ;S APCDADD=1
+13 IF $GET(MORE)'=""
SET APCDALVR("APCDAUTO")=1
SET APCDAUTO=1
+14 SET APCDALVR("APCDANE")=""
SET APCDALVR("AUPNTALK")=""
+15 QUIT
+16 ;
RPC(DATA,DFN,PARMS) ; EP -- BTPW CREATE CHART REVIEW
+1 ; Input
+2 ; DFN - Patient IEN
+3 ; PARMS - Parms string
+4 ;
+5 NEW UID,II,BTWIEN,APCDAUTO,APCDDATE,MORE,APCDALVR,NAME,PDATA,PFIEN,PTYP,VALUE,CHIEN,BQ,CNAM
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BTPWCHRT",UID))
+8 KILL @DATA
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWEVNT D UNWIND^%ZTER"
+11 ;
+12 SET @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$CHAR(30)
+13 SET BTWIEN=$$FIND1^DIC(90506.3,"","BX","Chart Review","","","ERROR")
+14 IF BTWIEN=0
Begin DoDot:1
+15 SET II=II+1
SET @DATA@(II)="-1^RPC Failed: Passed in window name "_DEF_" not found^"_$CHAR(30)
+16 SET II=II+1
SET @DATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+17 ;
+18 SET FILE=$PIECE(^BQI(90506.3,BTWIEN,0),U,2)
+19 SET PARMS=$GET(PARMS,"")
+20 IF PARMS=""
Begin DoDot:1
+21 SET LIST=""
SET BN=""
+22 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+23 KILL PARMS
+24 SET PARMS=LIST
+25 KILL LIST
End DoDot:1
+26 ;
+27 KILL APCDALVR
+28 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+29 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+30 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+31 SET PFIEN=$ORDER(^BQI(90506.3,BTWIEN,10,"AC",NAME,""))
+32 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+33 SET PTYP=$PIECE($GET(^BQI(90506.3,BTWIEN,10,PFIEN,1)),U,1)
+34 IF PTYP="D"
SET VALUE=$$DATE^BQIUL1(VALUE)
+35 IF PTYP="C"!(PTYP="K")
Begin DoDot:2
+36 IF VALUE=""
QUIT
+37 SET CHIEN=$ORDER(^BQI(90506.3,BTWIEN,10,PFIEN,5,"B",VALUE,""))
IF CHIEN=""
QUIT
+38 SET VALUE=$PIECE(^BQI(90506.3,BTWIEN,10,PFIEN,5,CHIEN,0),U,2)
End DoDot:2
+39 IF PTYP="W"
KILL BTPWP
Begin DoDot:2
+40 FOR BTI=1:1
SET BTJ=$PIECE(VALUE,$CHAR(10),BTI)
IF BTJ=""
QUIT
Begin DoDot:3
+41 SET BTWP(BTI,0)=BTJ
End DoDot:3
End DoDot:2
QUIT
+42 SET @NAME=VALUE
+43 SET APCDALVR(NAME)=VALUE
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+44 ;
+45 IF $GET(BTPWVIEN)'=""
Begin DoDot:1
+46 SET @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$CHAR(30)
+47 IF $GET(TIUDA)'=""
SET VISIT=BTPWVIEN
DO NOT
+48 SET II=II+1
SET @DATA@(II)="1^^"_BTPWVIEN_$CHAR(30)
+49 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+50 DO CLNUP(BTWIEN)
End DoDot:1
QUIT
+51 ;
+52 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+53 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+54 SET NAME=$PIECE(PDATA,"=",1)
+55 SET PFIEN=$ORDER(^BQI(90506.3,BTWIEN,10,"AC",NAME,""))
+56 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+57 SET FIELD=$PIECE($GET(^BQI(90506.3,BTWIEN,10,PFIEN,3)),U,1)
+58 SET EXEC=$GET(^BQI(90506.3,BTWIEN,10,PFIEN,7))
+59 IF EXEC'=""
XECUTE EXEC
QUIT
+60 IF FIELD=""
QUIT
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+61 SET MORE=1
+62 SET APCDDATE=$$NOW^XLFDT()
SET APCDALVR("APCDDATE")=APCDDATE
+63 SET APCDALVR("APCDPAT")=DFN
SET APCDPAT=DFN
+64 SET APCDALVR("APCDANE")=""
SET APCDALVR("AUPNTALK")=""
+65 SET APCDALVR("APCDLOC")=$SELECT($GET(APCDALVR("APCDLOC"))'="":APCDALVR("APCDLOC"),1:DUZ(2))
+66 SET APCDALVR("APCDTYPE")=$GET(APCDALVR("APCDTYPE"),"I")
+67 SET CLN=APCDALVR("APCDCLN")
+68 SET APCDHL=$SELECT(CLN=51:$PIECE(^BQICARE(DUZ,0),U,20),CLN=53:$PIECE(^BQICARE(DUZ,0),U,19),1:$PIECE(^BQICARE(DUZ,0),U,18))
+69 SET APCDALVR("APCDHL")=APCDHL
+70 SET CLN=$ORDER(^DIC(40.7,"C",CLN,""))
SET APCDALVR("APCDCLN")=CLN
+71 SET CNAM=$PIECE(^DIC(40.7,CLN,0),U,1)
+72 SET APCDALVR("APCDOPT")=$$FIND1^DIC(19,"","BX","BTPWRPC","","","ERROR")
+73 SET APCDALVR("APCDCAT")=$SELECT(CNAM["TELEPHONE":"T",1:"C")
+74 IF $GET(MORE)'=""
SET APCDALVR("APCDAUTO")=1
+75 ;
+76 ; Create visit and then update other Vfiles
+77 DO EN^APCDALV
+78 ; Check for error
+79 IF '$GET(APCDALVR("APCDAFLG"))
SET VISIT=$GET(APCDALVR("APCDVSIT"))
+80 IF $GET(APCDALVR("APCDAFLG"))=2
SET VISIT=-1
SET MSG="Unable to create chart review"
+81 IF $GET(APCDALVR("APCDAFLG"))=1
SET VISIT=-1
SET MSG="Chart review already exists"
+82 IF VISIT=-1
Begin DoDot:1
+83 SET @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$CHAR(30)
+84 SET II=II+1
SET @DATA@(II)="-1^"_MSG_"^"_$CHAR(30)
+85 SET II=II+1
SET @DATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+86 ;
+87 ; Set the Chart Review with provider
+88 KILL APCDALVR
+89 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
+90 SET APCDALVR("APCDTPS")="PRIMARY"
SET APCDALVR("APCDTPRO")=$PIECE(^VA(200,DUZ,0),U,1)
+91 SET APCDALVR("APCDPAT")=DFN
SET APCDALVR("APCDVSIT")=VISIT
+92 SET RESULT=$$ADD(DFN,VISIT,.APCDALVR)
+93 ;
+94 ; Note
+95 IF $GET(TIUDA)'=""
DO NOT
+96 ;
+97 ;POV
+98 KILL APCDALVR
+99 NEW APCDCAT,IEN
+100 SET APCDCAT=$PIECE(^AUPNVSIT(VISIT,0),"^",7)
+101 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
+102 SET APCDALVR("APCDTPOV")=$SELECT($GET(APCDCAT)="T":"Z71.9",1:$$CRPOV^BTPWPBTH())
+103 SET APCDALVR("APCDTPS")="PRIMARY"
+104 SET APCDALVR("APCDTNQ")=$SELECT($GET(APCDCAT)="T":"iCare Telephone Note|185317003",1:"iCare Chart Review|107728002")
+105 SET APCDALVR("APCDPAT")=DFN
SET APCDALVR("APCDVSIT")=VISIT
+106 SET RESULT=$$ADD(DFN,VISIT,.APCDALVR)
+107 SET IEN=$ORDER(^AUPNVPOV("AD",VISIT,""))
+108 SET BQIUPD(9000010.07,IEN_",",1101)=$SELECT($GET(APCDCAT)="T":185317003,1:107728002)
+109 SET BQIUPD(9000010.07,IEN_",",1102)=$SELECT($GET(APCDCAT)="T":285327012,1:202356017)
+110 DO FILE^DIE("","BQIUPD","ERROR")
+111 ;
+112 SET @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$CHAR(30)
+113 SET II=II+1
SET @DATA@(II)="1^^"_VISIT_$CHAR(30)
+114 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+115 DO CLNUP(BTWIEN)
+116 QUIT
+117 ;
NOT ;Note
+1 KILL APCDALVR
+2 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.28 (ADD)]"
+3 SET APCDALVR("APCDTDOC")=TIUDA
+4 SET APCDALVR("APCDPAT")=DFN
SET APCDALVR("APCDVSIT")=VISIT
+5 SET RESULT=$$ADD(DFN,VISIT,.APCDALVR)
+6 QUIT
+7 ;
TRIG(DATA,APCDCLN) ;EP -- BTPW CHART REVIEW TRIGGER
+1 NEW UID,II,VALUE,SOURCE,TYPE,ABLE,CLEAR,CLFLG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWCHTR",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWBTTR D UNWIND^%ZTER"
+7 ;
+8 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T00001CLEAR_FLAG^T00060CLEAR_FIELDS^T01024PARMS"_$CHAR(30)
+9 IF APCDCLN=51
SET VALUE="T"_$CHAR(28)_"TELEPHONE"
+10 IF APCDCLN'=51
SET VALUE="C"_$CHAR(28)_"CHART REVIEW"
+11 SET SOURCE="APCDCAT"
SET TYPE="C"
SET ABLE="Y"
SET CLEAR=""
SET CLFLG="N"
DO UP
+12 SET VALUE=""
+13 IF APCDCLN=51
SET VALUE=$PIECE(^BQICARE(DUZ,0),U,20)
IF VALUE'=""
SET VALUE=VALUE_$CHAR(28)_$PIECE(^SC(VALUE,0),U,1)
+14 IF APCDCLN=52
SET VALUE=$PIECE(^BQICARE(DUZ,0),U,18)
IF VALUE'=""
SET VALUE=VALUE_$CHAR(28)_$PIECE(^SC(VALUE,0),U,1)
+15 IF APCDCLN=53
SET VALUE=$PIECE(^BQICARE(DUZ,0),U,19)
IF VALUE'=""
SET VALUE=VALUE_$CHAR(28)_$PIECE(^SC(VALUE,0),U,1)
+16 SET SOURCE="APCDHL"
SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
DO UP
+17 IF APCDCLN=51
SET VALUE="iCare Telephone Note"
+18 IF APCDCLN'=51
SET VALUE="iCare Chart Review"
+19 SET SOURCE="APCDTNQ"
SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
DO UP
+20 QUIT
+21 ;
UP ; Update
+1 SET II=II+1
SET @DATA@(II)=SOURCE_U_TYPE_U_$GET(ABLE)_U_CLFLG_U_$GET(CLEAR)_U_VALUE_$CHAR(30)
+2 QUIT
+3 ;
DEL(DATA,VISIT) ;EP -- BTPW DELETE CHART REVIEW
+1 NEW UID,II,APCDVDLT,USER,TO,FROM,DIK,DA,RESULT,DUSR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWDCHRT",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWEVNT D UNWIND^%ZTER"
+7 ;
+8 SET @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$CHAR(30)
+9 SET RESULT="1^^"
+10 IF $ORDER(^TIU(8925,"V",VISIT,""))'=""
SET RESULT="-1^TIU Document points to this visit. Cannot be deleted.^"
GOTO DONE
+11 XECUTE ^BTPW(90628,1,3)
+12 XECUTE DUSR
XECUTE TO
+13 SET DIK="^AUPNVPOV("
SET DA=$ORDER(^AUPNVPOV("AD",VISIT,""))
IF DA'=""
DO ^DIK
+14 SET DIK="^AUPNVPRV("
SET DA=$ORDER(^AUPNVPRV("AD",VISIT,""))
IF DA'=""
DO ^DIK
+15 SET DIK="^AUPNVNOT("
SET DA=$ORDER(^AUPNVNOT("AD",VISIT,""))
IF DA'=""
DO ^DIK
+16 SET DIK="^AUPNVSIT("
SET DA=VISIT
DO ^DIK
+17 XECUTE FROM
+18 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
CLNUP(VFIEN) ; Clean up variables
+1 NEW NAME
+2 SET NAME=""
+3 FOR
SET NAME=$ORDER(^BQI(90506.3,VFIEN,10,"AC",NAME))
IF NAME=""
QUIT
KILL @NAME
+4 QUIT
