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

BTPWPCHT.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. EN(NOT,DFN,MORE) ; EP - Create a chart review visit
  1.  ; Input
  1.  ;   NOT = Notification Type
  1.  ;
  1.  NEW APCDAUTO,NCLN,CLN,CNAM,APCDCAT,APCDDATE,CLIN,VTYP
  1.  S NCLN=$P(^BTPW(90622,NOT,0),U,4),MORE=$G(MORE,"")
  1.  S CLN=""
  1.  F  S CLN=$O(^DIC(40.7,"C",NCLN,CLN)) Q:CLN=""  S CLIN=CLN
  1.  S CNAM=$P(^DIC(40.7,CLIN,0),U,1)
  1.  ;
  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))
  1.  D DEF(CLIN,CNAM,DFN,$G(APCDLOC),$G(APCDHL))
  1.  ;
  1.  ;  Create visit and then update other Vfiles
  1.  D EN^APCDALV
  1.  ; Check for error
  1.  I '$G(APCDALVR("APCDAFLG")) S VISIT=$G(APCDALVR("APCDVSIT"))
  1.  I $G(APCDALVR("APCDAFLG"))=2!($G(APCDALVR("APCDAFLG"))=1) S VISIT=-1
  1.  Q VISIT
  1.  ;
  1. ADD(APCDPAT,APCDVSIT,APCDALVR) ; EP 
  1.  ; Create V files
  1.  D EN^APCDALVR
  1.  ; Check for error
  1.  I '$G(APCDALVR("APCDAFLG")) S RESULT=1
  1.  I $G(APCDALVR("APCDAFLG"))=2 S RESULT=-1
  1.  ; Cleanup
  1.  K APCDALVR
  1.  Q RESULT
  1.  ;
  1. DEF(CLN,CNAM,DFN,APCDLOC,APCDHL) ; Set variables
  1.  S APCDALVR("APCDCLN")=CLN
  1.  S APCDALVR("APCDHL")=APCDHL
  1.  S APCDDATE=$$NOW^XLFDT(),APCDALVR("APCDDATE")=APCDDATE
  1.  ; Get default Visit Type
  1.  S VTYP=$P($G(^APCDSITE(DUZ(2),0)),U,11) I VTYP="" S VTYP="I"
  1.  S APCDALVR("APCDTYPE")=VTYP
  1.  S APCDCAT=$S(CNAM["TELEPHONE":"T",1:"C")
  1.  S APCDALVR("APCDCAT")=APCDCAT
  1.  S APCDLOC=DUZ(2),APCDALVR("APCDLOC")=APCDLOC
  1.  S APCDALVR("APCDPAT")=DFN,APCDPAT=DFN
  1.  S APCDALVR("APCDOPT")=$$FIND1^DIC(19,"","BX","BTPWRPC","","","ERROR")
  1.  ;S APCDADD=1
  1.  I $G(MORE)'="" S APCDALVR("APCDAUTO")=1,APCDAUTO=1
  1.  S APCDALVR("APCDANE")="",APCDALVR("AUPNTALK")=""
  1.  Q
  1.  ;
  1. RPC(DATA,DFN,PARMS) ; EP -- BTPW CREATE CHART REVIEW
  1.  ; Input
  1.  ;   DFN   - Patient IEN
  1.  ;   PARMS - Parms string
  1.  ;
  1.  NEW UID,II,BTWIEN,APCDAUTO,APCDDATE,MORE,APCDALVR,NAME,PDATA,PFIEN,PTYP,VALUE,CHIEN,BQ,CNAM
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWCHRT",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVNT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
  1.  S BTWIEN=$$FIND1^DIC(90506.3,"","BX","Chart Review","","","ERROR")
  1.  I BTWIEN=0 D  Q
  1.  . S II=II+1,@DATA@(II)="-1^RPC Failed: Passed in window name "_DEF_" not found^"_$C(30)
  1.  . S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  S FILE=$P(^BQI(90506.3,BTWIEN,0),U,2)
  1.  S PARMS=$G(PARMS,"")
  1.  I PARMS="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  S LIST=LIST_PARMS(BN)
  1.  . K PARMS
  1.  . S PARMS=LIST
  1.  . K LIST
  1.  ;
  1.  K APCDALVR
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . S PFIEN=$O(^BQI(90506.3,BTWIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1.  . S PTYP=$P($G(^BQI(90506.3,BTWIEN,10,PFIEN,1)),U,1)
  1.  . I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . I PTYP="C"!(PTYP="K") D
  1.  .. I VALUE="" Q
  1.  .. S CHIEN=$O(^BQI(90506.3,BTWIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
  1.  .. S VALUE=$P(^BQI(90506.3,BTWIEN,10,PFIEN,5,CHIEN,0),U,2)
  1.  . I PTYP="W" K BTPWP D  Q
  1.  .. F BTI=1:1  S BTJ=$P(VALUE,$C(10),BTI) Q:BTJ=""  D
  1.  ... S BTWP(BTI,0)=BTJ
  1.  . S @NAME=VALUE
  1.  . S APCDALVR(NAME)=VALUE
  1.  ;
  1.  I $G(BTPWVIEN)'="" D  Q
  1.  . S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
  1.  . I $G(TIUDA)'="" S VISIT=BTPWVIEN D NOT
  1.  . S II=II+1,@DATA@(II)="1^^"_BTPWVIEN_$C(30)
  1.  . S II=II+1,@DATA@(II)=$C(31)
  1.  . D CLNUP(BTWIEN)
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1)
  1.  . S PFIEN=$O(^BQI(90506.3,BTWIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1.  . S FIELD=$P($G(^BQI(90506.3,BTWIEN,10,PFIEN,3)),U,1)
  1.  . S EXEC=$G(^BQI(90506.3,BTWIEN,10,PFIEN,7))
  1.  . I EXEC'="" X EXEC Q
  1.  . I FIELD="" Q
  1.  S MORE=1
  1.  S APCDDATE=$$NOW^XLFDT(),APCDALVR("APCDDATE")=APCDDATE
  1.  S APCDALVR("APCDPAT")=DFN,APCDPAT=DFN
  1.  S APCDALVR("APCDANE")="",APCDALVR("AUPNTALK")=""
  1.  S APCDALVR("APCDLOC")=$S($G(APCDALVR("APCDLOC"))'="":APCDALVR("APCDLOC"),1:DUZ(2))
  1.  S APCDALVR("APCDTYPE")=$G(APCDALVR("APCDTYPE"),"I")
  1.  S CLN=APCDALVR("APCDCLN")
  1.  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))
  1.  S APCDALVR("APCDHL")=APCDHL
  1.  S CLN=$O(^DIC(40.7,"C",CLN,"")),APCDALVR("APCDCLN")=CLN
  1.  S CNAM=$P(^DIC(40.7,CLN,0),U,1)
  1.  S APCDALVR("APCDOPT")=$$FIND1^DIC(19,"","BX","BTPWRPC","","","ERROR")
  1.  S APCDALVR("APCDCAT")=$S(CNAM["TELEPHONE":"T",1:"C")
  1.  I $G(MORE)'="" S APCDALVR("APCDAUTO")=1
  1.  ;
  1.  ;  Create visit and then update other Vfiles
  1.  D EN^APCDALV
  1.  ; Check for error
  1.  I '$G(APCDALVR("APCDAFLG")) S VISIT=$G(APCDALVR("APCDVSIT"))
  1.  I $G(APCDALVR("APCDAFLG"))=2 S VISIT=-1,MSG="Unable to create chart review"
  1.  I $G(APCDALVR("APCDAFLG"))=1 S VISIT=-1,MSG="Chart review already exists"
  1.  I VISIT=-1 D  Q
  1.  . S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
  1.  . S II=II+1,@DATA@(II)="-1^"_MSG_"^"_$C(30)
  1.  . S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  ; Set the Chart Review with provider
  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")=DFN,APCDALVR("APCDVSIT")=VISIT
  1.  S RESULT=$$ADD(DFN,VISIT,.APCDALVR)
  1.  ;
  1.  ; Note
  1.  I $G(TIUDA)'="" D NOT
  1.  ;
  1.  ;POV
  1.  K APCDALVR
  1.  NEW APCDCAT,IEN
  1.  S APCDCAT=$P(^AUPNVSIT(VISIT,0),"^",7)
  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")=DFN,APCDALVR("APCDVSIT")=VISIT
  1.  S RESULT=$$ADD(DFN,VISIT,.APCDALVR)
  1.  S IEN=$O(^AUPNVPOV("AD",VISIT,""))
  1.  S BQIUPD(9000010.07,IEN_",",1101)=$S($G(APCDCAT)="T":185317003,1:107728002)
  1.  S BQIUPD(9000010.07,IEN_",",1102)=$S($G(APCDCAT)="T":285327012,1:202356017)
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
  1.  S II=II+1,@DATA@(II)="1^^"_VISIT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  D CLNUP(BTWIEN)
  1.  Q
  1.  ;
  1. NOT ;Note
  1.  K APCDALVR
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.28 (ADD)]"
  1.  S APCDALVR("APCDTDOC")=TIUDA
  1.  S APCDALVR("APCDPAT")=DFN,APCDALVR("APCDVSIT")=VISIT
  1.  S RESULT=$$ADD(DFN,VISIT,.APCDALVR)
  1.  Q
  1.  ;
  1. TRIG(DATA,APCDCLN) ;EP -- BTPW CHART REVIEW TRIGGER
  1.  NEW UID,II,VALUE,SOURCE,TYPE,ABLE,CLEAR,CLFLG
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWCHTR",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWBTTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T00001CLEAR_FLAG^T00060CLEAR_FIELDS^T01024PARMS"_$C(30)
  1.  I APCDCLN=51 S VALUE="T"_$C(28)_"TELEPHONE"
  1.  I APCDCLN'=51 S VALUE="C"_$C(28)_"CHART REVIEW"
  1.  S SOURCE="APCDCAT",TYPE="C",ABLE="Y",CLEAR="",CLFLG="N" D UP
  1.  S VALUE=""
  1.  I APCDCLN=51 S VALUE=$P(^BQICARE(DUZ,0),U,20) I VALUE'="" S VALUE=VALUE_$C(28)_$P(^SC(VALUE,0),U,1)
  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)
  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)
  1.  S SOURCE="APCDHL",TYPE="T",ABLE="Y",CLEAR="" D UP
  1.  I APCDCLN=51 S VALUE="iCare Telephone Note"
  1.  I APCDCLN'=51 S VALUE="iCare Chart Review"
  1.  S SOURCE="APCDTNQ",TYPE="T",ABLE="Y",CLEAR="" D UP
  1.  Q
  1.  ;
  1. UP ; Update
  1.  S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_$G(ABLE)_U_CLFLG_U_$G(CLEAR)_U_VALUE_$C(30)
  1.  Q
  1.  ;
  1. DEL(DATA,VISIT) ;EP -- BTPW DELETE CHART REVIEW
  1.  NEW UID,II,APCDVDLT,USER,TO,FROM,DIK,DA,RESULT,DUSR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWDCHRT",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVNT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010RESULT^T00080MESSAGE^I00010VISIT_IEN"_$C(30)
  1.  S RESULT="1^^"
  1.  I $O(^TIU(8925,"V",VISIT,""))'="" S RESULT="-1^TIU Document points to this visit. Cannot be deleted.^" G DONE
  1.  X ^BTPW(90628,1,3)
  1.  X DUSR X TO
  1.  S DIK="^AUPNVPOV(",DA=$O(^AUPNVPOV("AD",VISIT,"")) I DA'="" D ^DIK
  1.  S DIK="^AUPNVPRV(",DA=$O(^AUPNVPRV("AD",VISIT,"")) I DA'="" D ^DIK
  1.  S DIK="^AUPNVNOT(",DA=$O(^AUPNVNOT("AD",VISIT,"")) I DA'="" D ^DIK
  1.  S DIK="^AUPNVSIT(",DA=VISIT D ^DIK
  1.  X FROM
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CLNUP(VFIEN) ; Clean up variables
  1.  NEW NAME
  1.  S NAME=""
  1.  F  S NAME=$O(^BQI(90506.3,VFIEN,10,"AC",NAME)) Q:NAME=""  K @NAME
  1.  Q