BTPWPEVC ;VNGT/HS/ALA-Get the tracked events - Continued ; 21 Sep 2009 12:00 PM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
RES(DATA,CMIEN) ; EP -- BTPW GET EVENT RESULTS
NEW UID,II,HDR,BN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPERS",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPEVC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="I00010RSIEN^D00030RESULT_DATETIME^T00050RESULT^T00035ENTERED_BY^T00003FOLLOWUP^T01024RES_COMMENT"
S @DATA@(II)=HDR_$C(30)
S BN=0
F S BN=$O(^BTPWP(CMIEN,5,BN)) Q:'BN D
. NEW DA,IENS,RSDT,RES,RWHO,FOL,RCN,RCOMM
. S DA(1)=CMIEN,DA=BN,IENS=$$IENS^DILF(.DA)
. S RSDT=$$FMTE^BQIUL1($$GET1^DIQ(90620.05,IENS,.01,"I"))
. S RES=$$GET1^DIQ(90620.05,IENS,.02,"E")
. S RWHO=$$GET1^DIQ(90620.05,IENS,.03,"E")
. S FOL="N" I $O(^BTPWP(CMIEN,5,BN,5,0))'="" S FOL="Y"
. S RCOMM=""
. S RCN=0
. F S RCN=$O(^BTPWP(CMIEN,5,BN,1,RCN)) Q:'RCN D
.. S RCOMM=RCOMM_^BTPWP(CMIEN,5,BN,1,RCN,0)_$C(10)
. S II=II+1,@DATA@(II)=BN_U_RSDT_U_RES_U_RWHO_U_FOL_U_RCOMM_$C(30)
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
FOL(DATA,CMIEN,RSIEN) ; EP -- BTPW GET EVENT FOLLOWUPS
NEW UID,II,BN,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPEFL",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPEVC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="I00010FLIEN^D00030FOLLOW_DATETIME^T00050FOL_TYPE^T00035FWHO^D00030FOLLOW_DUE^T00001NOTIFICATION^T01024FOL_COMMENT"
S @DATA@(II)=HDR_$C(30)
S BN=0
F S BN=$O(^BTPWP(CMIEN,5,RSIEN,5,BN)) Q:'BN D
. NEW DA,FCN,FCOMM,FLDT,FOL,FWHO,FDUE,IENS,NOT
. S DA(2)=CMIEN,DA(1)=RSIEN,DA=BN,IENS=$$IENS^DILF(.DA)
. S FLDT=$$FMTE^BQIUL1($$GET1^DIQ(90620.55,IENS,.01,"I"))
. S FOL=$$GET1^DIQ(90620.55,IENS,.02,"E")
. S FWHO=$$GET1^DIQ(90620.55,IENS,.03,"E")
. S FDUE=$$FMTE^BQIUL1($$GET1^DIQ(90620.55,IENS,.04,"I"))
. S NOT="N" I $O(^BTPWP(CMIEN,5,RSIEN,5,BN,5,0))'="" S NOT="Y"
. S FCOMM=""
. S FCN=0
. F S FCN=$O(^BTPWP(CMIEN,5,RSIEN,5,BN,1,FCN)) Q:'FCN D
.. S FCOMM=FCOMM_^BTPWP(CMIEN,5,RSIEN,5,BN,1,FCN,0)_$C(10)
. S II=II+1,@DATA@(II)=BN_U_FLDT_U_FOL_U_FWHO_U_FDUE_U_NOT_U_FCOMM_$C(30)
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
NOT(DATA,CMIEN,RSIEN,FLIEN) ; EP -- BTPW GET EVENT NOTIFICATIONS
NEW UID,HDR,II,BN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPENT",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPEVC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="I00010NTIEN^D00030NOT_DATETIME^T00030NOT_TYPE^T00035NOT_BY^D00030NOT_DUE^I00010TIUIEN^T00060DOCUMENT^T01024NOT_COMMENT"
S @DATA@(II)=HDR_$C(30)
S BN=0
F S BN=$O(^BTPWP(CMIEN,5,RSIEN,5,FLIEN,5,BN)) Q:'BN D
. NEW DA,DOC,IENS,NTDT,NOT,NWHO,NDUE,TIUIEN,NCOMM,NCN
. S DA(3)=CMIEN,DA(2)=RSIEN,DA(1)=FLIEN,DA=BN,IENS=$$IENS^DILF(.DA)
. S NTDT=$$FMTE^BQIUL1($$GET1^DIQ(90620.555,IENS,.01,"I"))
. S NOT=$$GET1^DIQ(90620.555,IENS,.02,"E")
. S NWHO=$$GET1^DIQ(90620.555,IENS,.03,"E")
. S NDUE=$$FMTE^BQIUL1($$GET1^DIQ(90620.555,IENS,.04,"I"))
. S TIUIEN=$$GET1^DIQ(90620.555,IENS,.05,"I")
. S DOC=$$GET1^DIQ(90620.555,IENS,.05,"E")
. S NCOMM=""
. S NCN=0
. F S NCN=$O(^BTPWP(CMIEN,5,RSIEN,5,FLIEN,5,BN,1,NCN)) Q:'NCN D
.. S NCOMM=NCOMM_^BTPWP(CMIEN,5,RSIEN,5,FLIEN,BN,1,NCN,0)_$C(10)
. S II=II+1,@DATA@(II)=BN_U_NTDT_U_NOT_U_NWHO_U_NDUE_U_TIUIEN_U_DOC_U_NCOMM_$C(30)
;
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
BTPWPEVC ;VNGT/HS/ALA-Get the tracked events - Continued ; 21 Sep 2009 12:00 PM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
RES(DATA,CMIEN) ; EP -- BTPW GET EVENT RESULTS
+1 NEW UID,II,HDR,BN
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWPERS",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPEVC D UNWIND^%ZTER"
+8 ;
+9 SET HDR="I00010RSIEN^D00030RESULT_DATETIME^T00050RESULT^T00035ENTERED_BY^T00003FOLLOWUP^T01024RES_COMMENT"
+10 SET @DATA@(II)=HDR_$CHAR(30)
+11 SET BN=0
+12 FOR
SET BN=$ORDER(^BTPWP(CMIEN,5,BN))
IF 'BN
QUIT
Begin DoDot:1
+13 NEW DA,IENS,RSDT,RES,RWHO,FOL,RCN,RCOMM
+14 SET DA(1)=CMIEN
SET DA=BN
SET IENS=$$IENS^DILF(.DA)
+15 SET RSDT=$$FMTE^BQIUL1($$GET1^DIQ(90620.05,IENS,.01,"I"))
+16 SET RES=$$GET1^DIQ(90620.05,IENS,.02,"E")
+17 SET RWHO=$$GET1^DIQ(90620.05,IENS,.03,"E")
+18 SET FOL="N"
IF $ORDER(^BTPWP(CMIEN,5,BN,5,0))'=""
SET FOL="Y"
+19 SET RCOMM=""
+20 SET RCN=0
+21 FOR
SET RCN=$ORDER(^BTPWP(CMIEN,5,BN,1,RCN))
IF 'RCN
QUIT
Begin DoDot:2
+22 SET RCOMM=RCOMM_^BTPWP(CMIEN,5,BN,1,RCN,0)_$CHAR(10)
End DoDot:2
+23 SET II=II+1
SET @DATA@(II)=BN_U_RSDT_U_RES_U_RWHO_U_FOL_U_RCOMM_$CHAR(30)
End DoDot:1
+24 ;
+25 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+26 QUIT
+27 ;
FOL(DATA,CMIEN,RSIEN) ; EP -- BTPW GET EVENT FOLLOWUPS
+1 NEW UID,II,BN,HDR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWPEFL",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPEVC D UNWIND^%ZTER"
+8 ;
+9 SET HDR="I00010FLIEN^D00030FOLLOW_DATETIME^T00050FOL_TYPE^T00035FWHO^D00030FOLLOW_DUE^T00001NOTIFICATION^T01024FOL_COMMENT"
+10 SET @DATA@(II)=HDR_$CHAR(30)
+11 SET BN=0
+12 FOR
SET BN=$ORDER(^BTPWP(CMIEN,5,RSIEN,5,BN))
IF 'BN
QUIT
Begin DoDot:1
+13 NEW DA,FCN,FCOMM,FLDT,FOL,FWHO,FDUE,IENS,NOT
+14 SET DA(2)=CMIEN
SET DA(1)=RSIEN
SET DA=BN
SET IENS=$$IENS^DILF(.DA)
+15 SET FLDT=$$FMTE^BQIUL1($$GET1^DIQ(90620.55,IENS,.01,"I"))
+16 SET FOL=$$GET1^DIQ(90620.55,IENS,.02,"E")
+17 SET FWHO=$$GET1^DIQ(90620.55,IENS,.03,"E")
+18 SET FDUE=$$FMTE^BQIUL1($$GET1^DIQ(90620.55,IENS,.04,"I"))
+19 SET NOT="N"
IF $ORDER(^BTPWP(CMIEN,5,RSIEN,5,BN,5,0))'=""
SET NOT="Y"
+20 SET FCOMM=""
+21 SET FCN=0
+22 FOR
SET FCN=$ORDER(^BTPWP(CMIEN,5,RSIEN,5,BN,1,FCN))
IF 'FCN
QUIT
Begin DoDot:2
+23 SET FCOMM=FCOMM_^BTPWP(CMIEN,5,RSIEN,5,BN,1,FCN,0)_$CHAR(10)
End DoDot:2
+24 SET II=II+1
SET @DATA@(II)=BN_U_FLDT_U_FOL_U_FWHO_U_FDUE_U_NOT_U_FCOMM_$CHAR(30)
End DoDot:1
+25 ;
+26 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+27 QUIT
+28 ;
NOT(DATA,CMIEN,RSIEN,FLIEN) ; EP -- BTPW GET EVENT NOTIFICATIONS
+1 NEW UID,HDR,II,BN
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWPENT",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPEVC D UNWIND^%ZTER"
+8 ;
+9 SET HDR="I00010NTIEN^D00030NOT_DATETIME^T00030NOT_TYPE^T00035NOT_BY^D00030NOT_DUE^I00010TIUIEN^T00060DOCUMENT^T01024NOT_COMMENT"
+10 SET @DATA@(II)=HDR_$CHAR(30)
+11 SET BN=0
+12 FOR
SET BN=$ORDER(^BTPWP(CMIEN,5,RSIEN,5,FLIEN,5,BN))
IF 'BN
QUIT
Begin DoDot:1
+13 NEW DA,DOC,IENS,NTDT,NOT,NWHO,NDUE,TIUIEN,NCOMM,NCN
+14 SET DA(3)=CMIEN
SET DA(2)=RSIEN
SET DA(1)=FLIEN
SET DA=BN
SET IENS=$$IENS^DILF(.DA)
+15 SET NTDT=$$FMTE^BQIUL1($$GET1^DIQ(90620.555,IENS,.01,"I"))
+16 SET NOT=$$GET1^DIQ(90620.555,IENS,.02,"E")
+17 SET NWHO=$$GET1^DIQ(90620.555,IENS,.03,"E")
+18 SET NDUE=$$FMTE^BQIUL1($$GET1^DIQ(90620.555,IENS,.04,"I"))
+19 SET TIUIEN=$$GET1^DIQ(90620.555,IENS,.05,"I")
+20 SET DOC=$$GET1^DIQ(90620.555,IENS,.05,"E")
+21 SET NCOMM=""
+22 SET NCN=0
+23 FOR
SET NCN=$ORDER(^BTPWP(CMIEN,5,RSIEN,5,FLIEN,5,BN,1,NCN))
IF 'NCN
QUIT
Begin DoDot:2
+24 SET NCOMM=NCOMM_^BTPWP(CMIEN,5,RSIEN,5,FLIEN,BN,1,NCN,0)_$CHAR(10)
End DoDot:2
+25 SET II=II+1
SET @DATA@(II)=BN_U_NTDT_U_NOT_U_NWHO_U_NDUE_U_TIUIEN_U_DOC_U_NCOMM_$CHAR(30)
End DoDot:1
+26 ;
+27 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+28 QUIT
+29 ;
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
