- 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
