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

BTPWEVNT.m

Go to the documentation of this file. 
  1. BTPWEVNT ;VNGT/HS/ALA-Get Event Data for Worksheet ; 14 Aug 2009  1:23 PM
  1.  ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
  1.  ;
  1.  ;
  1. GET(DATA,CMIEN) ;EP - BTPW GET EVENT
  1.  NEW UID,II
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWEVNT",UID))
  1.  K @DATA
  1.  ;
  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 HDR="T00040BTPWCAT^I00010CMIEN^T00060BTPWPRC^D00015BTPWPDT^T00030BTPWREC^T00004BTPWPREV^T00010BTPWSTGE^"
  1.  S HDR=HDR_"D00015BTPWRDUE^D00015BTPWFDUE^D00015BTPWNDUE^T00045BTPCLREA^T01024BTPOTCOM^T01024BTPEVCOM^"
  1.  S HDR=HDR_"T00030BTPWRECD^T00030BTPWHIST^T00045BTPWETBY^D00030BTPWETDT^T00003BTPWFLUN^T00030PN^T00001SX^T00040HRN^T00010AGE^D00030DOB"
  1.  ;
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  D TREC(CMIEN,.RESULT)
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  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,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. TREC(QIEN,RESULT) ; EP
  1.  NEW TDATA,PROC,PROCNM,CAT,PRCDT,FDUE,TDATA1,STAGE,CLSRS,NDUE,RECORD,CLCOM,FLDUE,PREV,FLWND
  1.  NEW CN,EVCOM,RLINK,HIST,TRDTM,TRBY,DFN,SX,HRN,DOB,AGE,PN
  1.  S TDATA=^BTPWP(QIEN,0)
  1.  S PROC=$P(TDATA,U,1),PROCNM=$P(^BTPW(90621,PROC,0),U,1)
  1.  S CAT=$P(TDATA,U,12)_$C(28)_$$CAT^BTPWPDSP(PROC)
  1.  S PREV=$P(TDATA,U,11),PREV=$S(PREV'="":"Y"_$C(28)_"YES",1:"N"_$C(28)_"NONE")
  1.  S PRCDT=$$FMTE^BQIUL1($P(TDATA,U,3))
  1.  S DFN=$P(TDATA,U,2)
  1.  S PN=$$GET1^DIQ(2,DFN_",",.01,"E")
  1.  S SX=$$GET1^DIQ(2,DFN_",",.02,"I")
  1.  S HRN=$$HRNL^BQIULPT(DFN),HRN=$TR(HRN,";",$C(10))
  1.  S DOB=$$GET1^DIQ(9000001,DFN_",",1102.2,"I"),DOB=$$FMTE^BQIUL1(DOB)
  1.  S AGE=$$AGE^BQIAGE(DFN,,1)
  1.  S TDATA1=$G(^BTPWP(QIEN,1))
  1.  S STAGE=$P(TDATA1,U,1),STAGE=$S(STAGE="C":"C"_$C(28)_"Close",STAGE="O":"O"_$C(28)_"Open",1:"")
  1.  S CLSRS=$P(TDATA1,U,4) S:CLSRS]"" CLSRS=CLSRS_$C(28)_$$STC^BQIUL2(90620,1.04,CLSRS)
  1.  S FDUE=$$GET1^DIQ(90620,QIEN_",",1.05,"I"),FDUE=$$FMTE^BQIUL1(FDUE)
  1.  S FLDUE=$$GET1^DIQ(90620,QIEN_",",1.06,"I"),FLDUE=$$FMTE^BQIUL1(FLDUE)
  1.  S NDUE=$$GET1^DIQ(90620,QIEN_",",1.07,"I"),NDUE=$$FMTE^BQIUL1(NDUE)
  1.  S TRDTM=$$GET1^DIQ(90620,QIEN_",",1.02,"I"),TRDTM=$$FMTE^BQIUL1(TRDTM)
  1.  S TRBY=$$GET1^DIQ(90620,QIEN_",",1.03,"E")
  1.  S FLWND=$$GET1^DIQ(90620,QIEN_",",1.11,"I") S:FLWND]"" FLWND=FLWND_$C(28)_$$STC^BQIUL2(90620,1.11,FLWND)
  1.  S RECORD=$$LNK^BTPWPTRG(QIEN,.06),RLINK=$P(RECORD,$C(28),2,99)
  1.  S HIST="(None)" I $O(^BTPWP(QIEN,5,0))'="" S HIST="View"
  1.  S CLCOM="",CN=0 F  S CN=$O(^BTPWP(QIEN,3,CN)) Q:'CN  S CLCOM=CLCOM_$S(CLCOM]"":$C(10),1:"")_$G(^BTPWP(QIEN,3,CN,0))
  1.  S EVCOM="",CN=0 F  S CN=$O(^BTPWP(QIEN,4,CN)) Q:'CN  S EVCOM=EVCOM_$S(EVCOM]"":$C(10),1:"")_$G(^BTPWP(QIEN,4,CN,0))
  1.  ;
  1.  S RESULT=CAT_U_QIEN_U_PROC_$C(28)_PROCNM_U_PRCDT_U_$P(RECORD,$C(28),1)_U_PREV_U_STAGE_U_FDUE_U_FLDUE_U_NDUE_U_CLSRS_U_CLCOM_U_EVCOM_U_RLINK_U_HIST_U_TRBY_U_TRDTM_U_FLWND_U_PN_U_SX_U_HRN_U_AGE_U_DOB
  1.  Q
  1.  ;
  1. HIS(DATA,CMIEN) ; EP - BTPW GET EVENT HISTORY
  1.  NEW UID,II,TDATA,CURR,LIST,IEN,PROCNM,STAGE,EVDT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWEHIS",UID))
  1.  K @DATA
  1.  ;
  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)="I00010HIDE_CMET_IEN^T00060EVENT^D00015EVNT_DATE^T00015STAGE"_$C(30)
  1.  ;
  1.  S TDATA=$NA(^BTPWP),QFL=0
  1.  S CURR=CMIEN K LIST
  1.  F  D  Q:QFL
  1.  . S CMIEN=$P(@TDATA@(CMIEN,0),U,11) I CMIEN="" S QFL=1 Q
  1.  . S LIST(CMIEN)=""
  1.  S IEN=""
  1.  F  S IEN=$O(LIST(IEN)) Q:IEN=""  D
  1.  . S PROCNM=$$GET1^DIQ(90620,IEN_",",.01,"E")
  1.  . S STAGE=$$GET1^DIQ(90620,IEN_",",1.01,"E")
  1.  . S EVDT=$$GET1^DIQ(90620,IEN_",",.03,"I"),EVDT=$$FMTE^BQIUL1(EVDT)
  1.  . S II=II+1,@DATA@(II)=IEN_U_PROCNM_U_EVDT_U_STAGE_$C(30)
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. FND(DATA,CMIEN) ; EP - BTPW GET FINDINGS
  1.  NEW UID,II,HDR,FN,EVT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWEVFND",UID))
  1.  K @DATA
  1.  ;
  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 HDR="I00010CMIEN^I00010EVIEN^D00030BTPFNDTM^T00065BTPWPFND^T00030BTPWFNTR^T01024BTPFNCOM^T00005BTPFLND^T00005BTPWFNER^D00030BTPEDTM^T00045BTPEDBY"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  ;get data
  1.  S EVT=$P(^BTPWP(CMIEN,0),U,1)
  1.  S FN=0
  1.  F  S FN=$O(^BTPWP(CMIEN,10,FN)) Q:'FN  D
  1.  . NEW FNDATA,DTM,FND,INTR,NEED,FOL,COM,CN,EDTM,EDBY,EIE
  1.  . S FNDATA=^BTPWP(CMIEN,10,FN,0)
  1.  . S DTM=$P(FNDATA,U,1)
  1.  . S FND=$P(FNDATA,U,2) I FND'="" S FND=FND_$C(28)_$P(^BTPW(90620.9,FND,0),U,1)
  1.  . S INTR=$P(FNDATA,U,3),INTR=$S(INTR="I":"I"_$C(28)_"Incomplete",INTR="N":"N"_$C(28)_"Normal",INTR="A":"A"_$C(28)_"Abnormal",INTR="P":"P"_$C(28)_"N/A",1:"")
  1.  . S EDTM=$P(FNDATA,U,4)
  1.  . S EDBY=$P(FNDATA,U,5) I EDBY'="" S EDBY=EDBY_$C(28)_$P($G(^VA(200,EDBY,0)),U,1)
  1.  . S NEED=$P(FNDATA,U,6),NEED=$S(NEED="Y":"Y"_$C(28)_"Yes",NEED="N":"N"_$C(28)_"No",1:"")
  1.  . S EIE=$P(FNDATA,U,8)
  1.  . ;S FOL=$P(FNDATA,U,7) I FOL'="" S FOL=FOL_$C(28)_$P(^BTPW(90621,FOL,0),U,1)
  1.  . S COM="",CN=0
  1.  . F  S CN=$O(^BTPWP(CMIEN,10,FN,1,CN)) Q:'CN  S COM=COM_^BTPWP(CMIEN,10,FN,1,CN,0)_$C(10)
  1.  . S II=II+1,@DATA@(II)=CMIEN_U_FN_U_$$FMTE^BQIUL1(DTM)_U_FND_U_INTR_U_COM_U_NEED_U_EIE_U_$$FMTE^BQIUL1(EDTM)_U_EDBY_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. FOL(DATA,CMIEN) ; EP - BTPW GET FOLLOWUPS
  1.  NEW UID,II,HDR,FL
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWEVFOL",UID))
  1.  K @DATA
  1.  ;
  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 HDR="I00010CMIEN^I00010EVIEN^D00030BTPFLDTM^T00035BTPWPFOL^D00015BTPWPFLD^T01024BTPWPFCM^T00005BTPWFLER^D00030BTPEDTM^T00045BTPEDBY"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  ;get data
  1.  S FL=0
  1.  F  S FL=$O(^BTPWP(CMIEN,12,FL)) Q:'FL  D
  1.  . NEW FLDATA,DTM,FOL,FLDT,COM,CN,EDBY,EDTM,EIE
  1.  . S FLDATA=^BTPWP(CMIEN,12,FL,0)
  1.  . S DTM=$P(FLDATA,U,1)
  1.  . S FOL=$P(FLDATA,U,2) I FOL'="" S FOL=FOL_$C(28)_$P(^BTPW(90621,FOL,0),U,1)
  1.  . S FLDT=$P(FLDATA,U,5)
  1.  . S EDTM=$P(FLDATA,U,3)
  1.  . S EDBY=$P(FLDATA,U,4) I EDBY'="" S EDBY=EDBY_$C(28)_$P($G(^VA(200,EDBY,0)),U,1)
  1.  . S EIE=$P(FLDATA,U,7)
  1.  . S COM="",CN=0
  1.  . F  S CN=$O(^BTPWP(CMIEN,12,FL,1,CN)) Q:'CN  S COM=COM_^BTPWP(CMIEN,12,FL,1,CN,0)_$C(10)
  1.  . S II=II+1,@DATA@(II)=CMIEN_U_FL_U_$$FMTE^BQIUL1(DTM)_U_FOL_U_$$FMTE^BQIUL1(FLDT)_U_COM_U_EIE_U_$$FMTE^BQIUL1(EDTM)_U_EDBY_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. NOT(DATA,CMIEN) ; EP - BTPW GET NOTIFICATIONS
  1.  NEW UID,II,HDR,NT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWEVNOT",UID))
  1.  K @DATA
  1.  ;
  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 HDR="I00010CMIEN^I00010EVIEN^D00030BTPNDTM^T00030BTPWPNOT^T00030BTPWTDOC^T00030BTPWTTMP^T01024BTPNCOM^T00005BTPWNTER^D00030BTPEDTM^T00045BTPEDBY^"
  1.  S HDR=HDR_"T00030BTPWSIGN^T00015BTPWLNK^I00010TIUDA^I00010ADIEN^I00010BTPWVIEN"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  ;get data
  1.  S NT=0
  1.  F  S NT=$O(^BTPWP(CMIEN,11,NT)) Q:'NT  D
  1.  . NEW NTDATA,DTM,NOT,DOC,TMP,COM,CN,EDTM,EDBY,SIG,LNK,EIE,TIUDA,ADIEN,VIEN
  1.  . S NTDATA=^BTPWP(CMIEN,11,NT,0)
  1.  . S DTM=$P(NTDATA,U,1)
  1.  . S EDTM=$P(NTDATA,U,3)
  1.  . S EDBY=$P(NTDATA,U,4) I EDBY'="" S EDBY=EDBY_$C(28)_$P($G(^VA(200,EDBY,0)),U,1)
  1.  . S NOT=$P(NTDATA,U,2) I NOT'="" S NOT=NOT_$C(28)_$P(^BTPW(90622,NOT,0),U,1)
  1.  . S DOC=$P(NTDATA,U,6) I DOC'="" S DOC=DOC_$C(28)_$P(^TIU(8925.1,DOC,0),U,1)
  1.  . S TMP=$P(NTDATA,U,7) I TMP'="" S TMP=TMP_$C(28)_$P(^TIU(8927,TMP,0),U,1)
  1.  . S LNK="Preview",SIG="N"
  1.  . S EIE=$P(NTDATA,U,9)
  1.  . S TIUDA=$P(NTDATA,U,5)
  1.  . S ADIEN=$P(NTDATA,U,10)
  1.  . S VIEN=$P(NTDATA,U,11)
  1.  . I TIUDA'="" S SIG=$S($P($G(^TIU(8925,TIUDA,15)),U,1)'="":"Y",1:"N")
  1.  . S COM="",CN=0
  1.  . F  S CN=$O(^BTPWP(CMIEN,11,NT,1,CN)) Q:'CN  S COM=COM_^BTPWP(CMIEN,11,NT,1,CN,0)_$C(10)
  1.  . S II=II+1,@DATA@(II)=CMIEN_U_NT_U_$$FMTE^BQIUL1(DTM)_U_NOT_U_DOC_U_TMP_U_COM_U_EIE_U_$$FMTE^BQIUL1(EDTM)_U_EDBY_U
  1.  . S @DATA@(II)=@DATA@(II)_SIG_U_LNK_U_TIUDA_U_ADIEN_U_VIEN_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q