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