BTPWHIST ;VNGT/HS/BEE-CMET History ; 04 Feb 2009 2:55 PM
;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17
Q
;
AUD(DATA,CMIEN) ;EP - BTPW EVENT AUDIT HISTORY
;
;This RPC returns any field changes recorded for a particular event
;
;Input: CMIEN - Event IEN
;
NEW UID,II,MDTTM,FLD,I
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWHIST",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWHIST D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="D00030BTPWLMDT^T00030BTPWLMBY^T00030BTPWCFLD^I00010BTPWENTR^T04096BTPWNVAL^T04096BTPWPVAL"_$C(30)
;
;Verify Event IEN was passed
I CMIEN="" G DONE
;
;Load FLD array
F I=1:1 S FLD=$P($T(FLDS+I),";;",2,99) Q:FLD="" S FLD($P(FLD,";"),$P(FLD,";",2))=$P(FLD,";",3,99)
;
;
S MDTTM="" F S MDTTM=$O(^BTPWP(CMIEN,5,"B",MDTTM),-1) Q:MDTTM="" D
. ;
. N MODDT,MIEN
. S MODDT=$$FMTE^BQIUL1(MDTTM)
. ;
. S MIEN="" F S MIEN=$O(^BTPWP(CMIEN,5,"B",MDTTM,MIEN),-1) Q:MIEN="" D
.. ;
.. N USER,FILFLD,FILE,FIELD,FNAME,FTYPE,PFILE,VTYPE,CUR,PRV,ENTRY,EXEC
.. ;
.. S USER=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",".02","I")
.. I USER>0 S USER=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",".02","E")
.. S FILFLD=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",".03","E")
.. S FILE=$P(FILFLD,":")
.. S FIELD=$P(FILFLD,":",2)
.. S ENTRY="" I FILE["." S ENTRY=$P($P(FILFLD,":",3),",")
.. S FLD=$G(FLD(FILE,FIELD)) Q:FLD=""
.. S FNAME=$P(FLD,";") S:FNAME="" FNAME=FILE_":"_FIELD
.. S FTYPE=$P(FLD,";",2)
.. S PFILE=$P(FLD,";",3)
.. S EXEC=$P(FLD,";",4)
.. S VTYPE=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",".04","I")
.. S (CUR,PRV)=""
.. ;
.. ;Get regular field current/previous values
.. I VTYPE="R" D
... ;
... N X
... ;
... ;Current Value
... S CUR=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",102,"E")
... I CUR]"",FTYPE="S" S CUR=$$STC^BQIUL2(FILE,FIELD,CUR)
... I CUR]"",FTYPE="D" S CUR=$$FMTE^BQIUL1(CUR)
... I CUR]"",FTYPE="P" S CUR=$$GET1^DIQ(PFILE,CUR_",",".01","E")
... I CUR]"",FTYPE="X" S X=CUR X EXEC S CUR=X
... ;
... ;Previous Value
... S PRV=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",101,"E")
... I PRV]"",FTYPE="S" S PRV=$$STC^BQIUL2(FILE,FIELD,PRV)
... I PRV]"",FTYPE="D" S PRV=$$FMTE^BQIUL1(PRV)
... I PRV]"",FTYPE="P" S PRV=$$GET1^DIQ(PFILE,PRV_",",".01","E")
... I PRV]"",FTYPE="X" S X=PRV X EXEC S PRV=X
.. ;
.. ;Get word processing current/previous values
.. I VTYPE="W" D
... ;
... ;Current Value
... N CVAR,WP,SIEN
... S CVAR=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",4,"","WP")
... S SIEN=0 F S SIEN=$O(WP(SIEN)) Q:'SIEN D
.... S CUR=CUR_$S(CUR]"":" ",1:"")_WP(SIEN)
... K CVAR,WP,SIEN
... ;
... ;Previous Value
... N CVAR,WP,SIEN
... S CVAR=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",3,"","WP")
... S SIEN=0 F S SIEN=$O(WP(SIEN)) Q:'SIEN D
.... S PRV=PRV_$S(PRV]"":" ",1:"")_WP(SIEN)
... K CVAR,WP,SIEN
.. ;
.. S II=II+1,@DATA@(II)=MODDT_U_USER_U_FNAME_U_ENTRY_U_CUR_U_PRV_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
RLOG(VAR,USER,DTTM,DESC) ;EP -- Log Change to Tracked File - Regular fields
;
N FIELD,FILE,IEN,ERROR
;
;Process each entry
S FILE="" F S FILE=$O(VAR(FILE)) Q:FILE="" S IEN="" F S IEN=$O(VAR(FILE,IEN)) Q:IEN="" S FIELD="" F S FIELD=$O(VAR(FILE,IEN,FIELD)) Q:FIELD="" D
. ;
. N BHIST,CV,DA,DIC,DLAYGO,FILFLD,NV,X,Y,CMIEN
. I FILE=90629 S CMIEN=$G(VAR(FILE,IEN,.14)) S:CMIEN'["," CMIEN=CMIEN_","
. E S CMIEN=IEN
. ;
. ;Get New Value
. S NV=VAR(FILE,IEN,FIELD)
. ;
. ;Pull current value
. S CV=$$GET1^DIQ(FILE,IEN,FIELD,"I")
. ;
. ;File/Field
. S FILFLD=FILE_":"_FIELD
. ;
. ;Quit if no difference in value
. I NV=CV!((NV="@")&(CV="")) Q
. ;
. ;Pull Event IEN
. S DA(1)=$P(CMIEN,",",$L(CMIEN,",")-1)
. ;
. ;Define new entry
. S DIC="^BTPWP("_DA(1)_",5,"
. S DIC(0)="L"
. S X=DTTM S:X="" X=$$NOW^XLFDT()
. S DLAYGO=90620.05,DIC(0)="L",DIC("P")=DLAYGO
. I '$D(^BTPWP(DA(1),5,0)) S ^BTPWP(DA(1),5,0)="^90620.05DA^^"
. K DO,DD D FILE^DICN
. S DA=+Y
. ;
. ;Set up data
. S BHIST(90620.05,DA_","_DA(1)_",",".02")=USER
. S BHIST(90620.05,DA_","_DA(1)_",",".03")=FILFLD_":"_IEN
. S BHIST(90620.05,DA_","_DA(1)_",",".04")="R"
. S BHIST(90620.05,DA_","_DA(1)_",",".05")=DESC
. S BHIST(90620.05,DA_","_DA(1)_",","101")=CV
. S BHIST(90620.05,DA_","_DA(1)_",","102")=NV
. ;
. ;Save History
. I $D(BHIST) D FILE^DIE("","BHIST","ERROR")
;
Q
;
WLOG(NCOM,FILFLD,IEN,USER,DTTM,DESC) ;EP -- Log Change to Tracked File - Word Processing field
;
N BHIST,CCOM,CHG,CVAR,DA,DIC,DLAYGO,FIELD,FILE,I,LST,NVAR,X,Y,ERROR
;
S FILE=$P(FILFLD,":")
S FIELD=$P(FILFLD,":",2)
;
;Set up comment reference variable
I '$D(NCOM(1)) S NVAR="@"
E S NVAR="NCOM"
;
;Process Save Comment
;
;Pull current value
S CVAR=$$GET1^DIQ(FILE,IEN,FIELD,"","CCOM")
;
S CHG=0,LST=""
S I="" F S I=$O(CCOM(I)) Q:I="" S LST=I I CCOM(I)'=$G(NCOM(I)) S CHG=1 Q
I CHG=0 I $O(NCOM(LST))]"" S CHG=1
;
;No change to comments
I CHG=0 Q
;
;Pull Event IEN
S DA(1)=$P(IEN,",",$L(IEN,",")-1)
;
;Define new entry
S DIC="^BTPWP("_DA(1)_",5,"
S DIC(0)="L"
S X=DTTM S:X="" X=$$NOW^XLFDT()
S DLAYGO=90620.05,DIC(0)="L",DIC("P")=DLAYGO
I '$D(^BTPWP(DA(1),5,0)) S ^BTPWP(DA(1),5,0)="^90620.05DA^^"
K DO,DD D FILE^DICN
S DA=+Y
;
;Set up data
S BHIST(90620.05,DA_","_DA(1)_",",".02")=USER
S BHIST(90620.05,DA_","_DA(1)_",",".03")=FILFLD_":"_IEN
S BHIST(90620.05,DA_","_DA(1)_",",".04")="W"
S BHIST(90620.05,DA_","_DA(1)_",",".05")=DESC
;
;Save History
I $D(BHIST) D FILE^DIE("","BHIST","ERROR") ;New Comments
;
;Save comments
D WP^DIE(90620.05,DA_","_DA(1)_",",3,"",CVAR) ;Save current comments
D WP^DIE(90620.05,DA_","_DA(1)_",",4,"",NVAR) ;Save new comments
Q
;
DLOG(FILE,IENS,USER,DTTM,DESC) ;EP -- Log Deleted Entry Values to History
;
N COM,VAL,RHIST,FIELD
;
;Pull existing field information
D GETS^DIQ(FILE,IENS,"**","I","VAL")
;
S FIELD="" F S FIELD=$O(VAL(FILE,IENS,FIELD)) Q:FIELD="" I FIELD'=1 S RHIST(FILE,IENS,FIELD)=""
;
;Save regular field history
D RLOG(.RHIST,USER,DTTM,DESC)
;
;Save comment field history
S COM(1)=""
D WLOG(.COM,FILE_":1",IENS,USER,DTTM,DESC)
;
Q
;
SLOG(RIEN,CMIEN,DTTM,USER,DESC) ;EP - Log Status Changes to History
;
N CV,FILFLD,IEN,PVIEN,ERROR
S (PVIEN,CV)="",FILFLD="90620:.08"
S IEN=0 F S IEN=$O(^BTPWQ(RIEN,2,IEN)) Q:'IEN D
. N BHIST,SDATA,NV,LDTTM,LUSER,DA,DIC,DLAYGO,X,Y
. S SDATA=$G(^BTPWQ(RIEN,2,IEN,0))
. S NV=$P(SDATA,U,2) ;Status value
. S LDTTM=$P(SDATA,U,4) ;Status changed date/time
. S LUSER=$P(SDATA,U,3) ;Status changed by
. ;
. ;Define new entry
. S DA(1)=CMIEN
. S DIC="^BTPWP("_DA(1)_",5,"
. S DIC(0)="L"
. S X=LDTTM S:X="" X=$$NOW^XLFDT()
. S DLAYGO=90620.05,DIC(0)="L",DIC("P")=DLAYGO
. I '$D(^BTPWP(DA(1),5,0)) S ^BTPWP(DA(1),5,0)="^90620.05DA^^"
. K DO,DD D FILE^DICN
. S DA=+Y
. ;
. ;Set up data
. S BHIST(90620.05,DA_","_DA(1)_",",".02")=LUSER
. S BHIST(90620.05,DA_","_DA(1)_",",".03")=FILFLD_":"_CMIEN
. S BHIST(90620.05,DA_","_DA(1)_",",".04")="R"
. S BHIST(90620.05,DA_","_DA(1)_",",".05")=DESC
. S BHIST(90620.05,DA_","_DA(1)_",","101")=CV
. S BHIST(90620.05,DA_","_DA(1)_",","102")=NV
. ;
. ;Save History
. I $D(BHIST) D FILE^DIE("","BHIST","ERROR")
. ;
. ;Save Status Comments
. D SWLOG(RIEN,CMIEN,IEN,PVIEN)
. ;
. ;Save New Value to Current
. S CV=NV,PVIEN=IEN
;
K BHIST,DA,DIC,ERROR
;
;Log current status change
;
N BHIST,DA,DIC,CVAR,PVWP,NVAR,NWP,CHG,LST,I,ERROR
;Define new entry
S DA(1)=CMIEN
S DIC="^BTPWP("_DA(1)_",5,"
S DIC(0)="L"
S X=DTTM S:X="" X=$$NOW^XLFDT()
S DLAYGO=90620.05,DIC(0)="L",DIC("P")=DLAYGO
I '$D(^BTPWP(DA(1),5,0)) S ^BTPWP(DA(1),5,0)="^90620.05DA^^"
K DO,DD D FILE^DICN
S DA=+Y
;
;Set up data
S BHIST(90620.05,DA_","_DA(1)_",",".02")=USER
S BHIST(90620.05,DA_","_DA(1)_",",".03")=FILFLD_":"_CMIEN
S BHIST(90620.05,DA_","_DA(1)_",",".04")="R"
S BHIST(90620.05,DA_","_DA(1)_",",".05")="Event Tracked"
S BHIST(90620.05,DA_","_DA(1)_",","101")=CV
S BHIST(90620.05,DA_","_DA(1)_",","102")="T"
;
;Save History
I $D(BHIST) D FILE^DIE("","BHIST","ERROR")
K BHIST,ERROR
;
;Log current Event Comment Change
;
N BHIST,ERROR
S FILE=90620
S FIELD=4
;
;Pull previous history value
I PVIEN]"" S CVAR=$$GET1^DIQ(90629.02,PVIEN_","_RIEN_",",1,"","PVWP")
;
;Pull current history value
S NVAR=$$GET1^DIQ(90629,RIEN_",",3,"","NWP")
;
S CHG=0,LST=""
S I="" F S I=$O(PVWP(I)) Q:I="" S LST=I I PVWP(I)'=$G(NWP(I)) S CHG=1 Q
I CHG=0 I $O(NWP(LST))]"" S CHG=1
;
;No change to comments
I CHG=0 Q
;
;Pull Event IEN
S DA(1)=CMIEN
;
;Define new entry
S DIC="^BTPWP("_DA(1)_",5,"
S DIC(0)="L"
S X=DTTM S:X="" X=$$NOW^XLFDT()
S DLAYGO=90620.05,DIC(0)="L",DIC("P")=DLAYGO
I '$D(^BTPWP(DA(1),5,0)) S ^BTPWP(DA(1),5,0)="^90620.05DA^^"
K DO,DD D FILE^DICN
S DA=+Y
;
;Set up data
S BHIST(90620.05,DA_","_DA(1)_",",".02")=USER
S BHIST(90620.05,DA_","_DA(1)_",",".03")="90620:4:"_CMIEN
S BHIST(90620.05,DA_","_DA(1)_",",".04")="W"
S BHIST(90620.05,DA_","_DA(1)_",",".05")="Event Tracked"
;
;Save History
I $D(BHIST) D FILE^DIE("","BHIST","ERROR") ;New Comments
;
;Save comments
D WP^DIE(90620.05,DA_","_DA(1)_",",3,"",CVAR) ;Save current comments
D WP^DIE(90620.05,DA_","_DA(1)_",",4,"",NVAR) ;Save new comments
Q
;
SWLOG(RIEN,CMIEN,NIEN,PVIEN) ;Save Status Comment Field History
;
N BHIST,CHG,CVAR,DA,DIC,DLAYGO,FIELD,FILE,I,LST,NVAR,X,Y,PVWP,NWP,SDATA,LDTTM,LUSER,ERROR
;
S FILE=90620
S FIELD=4
;
;Pull previous history value
I PVIEN]"" S CVAR=$$GET1^DIQ(90629.02,PVIEN_","_RIEN_",",1,"","PVWP")
;
;Pull current history value
I NIEN]"" S NVAR=$$GET1^DIQ(90629.02,NIEN_","_RIEN_",",1,"","NWP")
;
S CHG=0,LST=""
S I="" F S I=$O(PVWP(I)) Q:I="" S LST=I I PVWP(I)'=$G(NWP(I)) S CHG=1 Q
I CHG=0 I $O(NWP(LST))]"" S CHG=1
;
;No change to comments
I CHG=0 Q
;
;Pull Event IEN
S DA(1)=CMIEN
;
;Define new entry
S SDATA=$G(^BTPWQ(RIEN,2,NIEN,0))
S LDTTM=$P(SDATA,U,4) ;Status changed date/time
S LUSER=$P(SDATA,U,3) ;Status changed by
S DIC="^BTPWP("_DA(1)_",5,"
S DIC(0)="L"
S X=LDTTM S:X="" X=$$NOW^XLFDT()
S DLAYGO=90620.05,DIC(0)="L",DIC("P")=DLAYGO
I '$D(^BTPWP(DA(1),5,0)) S ^BTPWP(DA(1),5,0)="^90620.05DA^^"
K DO,DD D FILE^DICN
S DA=+Y
;
;Set up data
S BHIST(90620.05,DA_","_DA(1)_",",".02")=LUSER
S BHIST(90620.05,DA_","_DA(1)_",",".03")="90620:4:"_CMIEN
S BHIST(90620.05,DA_","_DA(1)_",",".04")="W"
S BHIST(90620.05,DA_","_DA(1)_",",".05")="Status Changes"
;
;Save History
I $D(BHIST) D FILE^DIE("","BHIST","ERROR") ;New Comments
;
;Save comments
D WP^DIE(90620.05,DA_","_DA(1)_",",3,"",CVAR) ;Save current comments
D WP^DIE(90620.05,DA_","_DA(1)_",",4,"",NVAR) ;Save new comments
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
;
FLDS ;;
;;90620;.07;Date/Time Identified;D;
;;90620;.08;Status;X;;S X=$S(X="P":"PENDING",X="N":"NOT TRACKED",X="E":"EXCEPTION",X="S":"SUPERSEDED",X="T":"TRACKED",1:"")
;;90620;1.01;Event State;S;
;;90620;1.02;Event Tracked Date/Time;D;
;;90620;1.03;Event Tracked By;P;200;
;;90620;1.04;Close Reason;S;
;;90620;1.05;Findings Due By;D;
;;90620;1.06;Follow-up Decision Due By;D;
;;90620;1.07;Notification Due By;D;
;;90620;1.09;Last Modified Date/Time;D;
;;90620;1.1;Last Modified By;P;200;
;;90620;1.11;Follow-up Recommended?;S;
;;90620;3;State Comment;W;
;;90620;4;Event Comment;W;
;;90620.01;.01;Findings - Date;D;
;;90620.01;.02;Findings - Result;P;90620.9;
;;90620.01;.03;Findings - Interpretation;S;
;;90620.01;.04;Findings - Entered Date/Time;D;
;;90620.01;.05;Findings - Entered By;P;200;
;;90620.01;.06;Findings - Follow-Up Needed?;S;
;;90620.01;.08;Findings - Entered In Error;S;
;;90620.01;1;Findings - Comment;W;
;;90620.012;.02;Follow-ups - Event;P;90621;
;;90620.012;.03;Follow-ups - Date Entered;D;
;;90620.012;.04;Follow-ups - Entered By;P;200
;;90620.012;.05;Follow-ups - Date Due;D;
;;90620.012;.07;Follow-ups - Entered In Error;S;
;;90620.012;1;Follow-ups - Comment;W;
;;90620.011;.01;Notifications - Date;D;
;;90620.011;.02;Notifications - Method;P;90622;
;;90620.011;.03;Notifications - Entry Date;D;
;;90620.011;.04;Notifications - Entered By;P;200;
;;90620.011;.05;Notifications - Document;P;8925;
;;90620.011;.06;Notifications - TIU Document;P;8927.1;
;;90620.011;.07;Notifications - TIU Template;P;8927;
;;90620.011;.09;Notifications - Entered In Error;S;
;;90620.011;.1;Notifications - Addendum;P;8925;
;;90620.011;1;Notifications - Comment;W;
;;
BTPWHIST ;VNGT/HS/BEE-CMET History ; 04 Feb 2009 2:55 PM
+1 ;;1.1;CARE MANAGEMENT EVENT TRACKING;**2**;Apr 01, 2015;Build 17
+2 QUIT
+3 ;
AUD(DATA,CMIEN) ;EP - BTPW EVENT AUDIT HISTORY
+1 ;
+2 ;This RPC returns any field changes recorded for a particular event
+3 ;
+4 ;Input: CMIEN - Event IEN
+5 ;
+6 NEW UID,II,MDTTM,FLD,I
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BTPWHIST",UID))
+9 KILL @DATA
+10 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWHIST D UNWIND^%ZTER"
+14 ;
+15 SET @DATA@(II)="D00030BTPWLMDT^T00030BTPWLMBY^T00030BTPWCFLD^I00010BTPWENTR^T04096BTPWNVAL^T04096BTPWPVAL"_$CHAR(30)
+16 ;
+17 ;Verify Event IEN was passed
+18 IF CMIEN=""
GOTO DONE
+19 ;
+20 ;Load FLD array
+21 FOR I=1:1
SET FLD=$PIECE($TEXT(FLDS+I),";;",2,99)
IF FLD=""
QUIT
SET FLD($PIECE(FLD,";"),$PIECE(FLD,";",2))=$PIECE(FLD,";",3,99)
+22 ;
+23 ;
+24 SET MDTTM=""
FOR
SET MDTTM=$ORDER(^BTPWP(CMIEN,5,"B",MDTTM),-1)
IF MDTTM=""
QUIT
Begin DoDot:1
+25 ;
+26 NEW MODDT,MIEN
+27 SET MODDT=$$FMTE^BQIUL1(MDTTM)
+28 ;
+29 SET MIEN=""
FOR
SET MIEN=$ORDER(^BTPWP(CMIEN,5,"B",MDTTM,MIEN),-1)
IF MIEN=""
QUIT
Begin DoDot:2
+30 ;
+31 NEW USER,FILFLD,FILE,FIELD,FNAME,FTYPE,PFILE,VTYPE,CUR,PRV,ENTRY,EXEC
+32 ;
+33 SET USER=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",".02","I")
+34 IF USER>0
SET USER=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",".02","E")
+35 SET FILFLD=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",".03","E")
+36 SET FILE=$PIECE(FILFLD,":")
+37 SET FIELD=$PIECE(FILFLD,":",2)
+38 SET ENTRY=""
IF FILE["."
SET ENTRY=$PIECE($PIECE(FILFLD,":",3),",")
+39 SET FLD=$GET(FLD(FILE,FIELD))
IF FLD=""
QUIT
+40 SET FNAME=$PIECE(FLD,";")
IF FNAME=""
SET FNAME=FILE_":"_FIELD
+41 SET FTYPE=$PIECE(FLD,";",2)
+42 SET PFILE=$PIECE(FLD,";",3)
+43 SET EXEC=$PIECE(FLD,";",4)
+44 SET VTYPE=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",".04","I")
+45 SET (CUR,PRV)=""
+46 ;
+47 ;Get regular field current/previous values
+48 IF VTYPE="R"
Begin DoDot:3
+49 ;
+50 NEW X
+51 ;
+52 ;Current Value
+53 SET CUR=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",102,"E")
+54 IF CUR]""
IF FTYPE="S"
SET CUR=$$STC^BQIUL2(FILE,FIELD,CUR)
+55 IF CUR]""
IF FTYPE="D"
SET CUR=$$FMTE^BQIUL1(CUR)
+56 IF CUR]""
IF FTYPE="P"
SET CUR=$$GET1^DIQ(PFILE,CUR_",",".01","E")
+57 IF CUR]""
IF FTYPE="X"
SET X=CUR
XECUTE EXEC
SET CUR=X
+58 ;
+59 ;Previous Value
+60 SET PRV=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",101,"E")
+61 IF PRV]""
IF FTYPE="S"
SET PRV=$$STC^BQIUL2(FILE,FIELD,PRV)
+62 IF PRV]""
IF FTYPE="D"
SET PRV=$$FMTE^BQIUL1(PRV)
+63 IF PRV]""
IF FTYPE="P"
SET PRV=$$GET1^DIQ(PFILE,PRV_",",".01","E")
+64 IF PRV]""
IF FTYPE="X"
SET X=PRV
XECUTE EXEC
SET PRV=X
End DoDot:3
+65 ;
+66 ;Get word processing current/previous values
+67 IF VTYPE="W"
Begin DoDot:3
+68 ;
+69 ;Current Value
+70 NEW CVAR,WP,SIEN
+71 SET CVAR=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",4,"","WP")
+72 SET SIEN=0
FOR
SET SIEN=$ORDER(WP(SIEN))
IF 'SIEN
QUIT
Begin DoDot:4
+73 SET CUR=CUR_$SELECT(CUR]"":" ",1:"")_WP(SIEN)
End DoDot:4
+74 KILL CVAR,WP,SIEN
+75 ;
+76 ;Previous Value
+77 NEW CVAR,WP,SIEN
+78 SET CVAR=$$GET1^DIQ(90620.05,MIEN_","_CMIEN_",",3,"","WP")
+79 SET SIEN=0
FOR
SET SIEN=$ORDER(WP(SIEN))
IF 'SIEN
QUIT
Begin DoDot:4
+80 SET PRV=PRV_$SELECT(PRV]"":" ",1:"")_WP(SIEN)
End DoDot:4
+81 KILL CVAR,WP,SIEN
End DoDot:3
+82 ;
+83 SET II=II+1
SET @DATA@(II)=MODDT_U_USER_U_FNAME_U_ENTRY_U_CUR_U_PRV_$CHAR(30)
End DoDot:2
End DoDot:1
+84 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
RLOG(VAR,USER,DTTM,DESC) ;EP -- Log Change to Tracked File - Regular fields
+1 ;
+2 NEW FIELD,FILE,IEN,ERROR
+3 ;
+4 ;Process each entry
+5 SET FILE=""
FOR
SET FILE=$ORDER(VAR(FILE))
IF FILE=""
QUIT
SET IEN=""
FOR
SET IEN=$ORDER(VAR(FILE,IEN))
IF IEN=""
QUIT
SET FIELD=""
FOR
SET FIELD=$ORDER(VAR(FILE,IEN,FIELD))
IF FIELD=""
QUIT
Begin DoDot:1
+6 ;
+7 NEW BHIST,CV,DA,DIC,DLAYGO,FILFLD,NV,X,Y,CMIEN
+8 IF FILE=90629
SET CMIEN=$GET(VAR(FILE,IEN,.14))
IF CMIEN'[","
SET CMIEN=CMIEN_","
+9 IF '$TEST
SET CMIEN=IEN
+10 ;
+11 ;Get New Value
+12 SET NV=VAR(FILE,IEN,FIELD)
+13 ;
+14 ;Pull current value
+15 SET CV=$$GET1^DIQ(FILE,IEN,FIELD,"I")
+16 ;
+17 ;File/Field
+18 SET FILFLD=FILE_":"_FIELD
+19 ;
+20 ;Quit if no difference in value
+21 IF NV=CV!((NV="@")&(CV=""))
QUIT
+22 ;
+23 ;Pull Event IEN
+24 SET DA(1)=$PIECE(CMIEN,",",$LENGTH(CMIEN,",")-1)
+25 ;
+26 ;Define new entry
+27 SET DIC="^BTPWP("_DA(1)_",5,"
+28 SET DIC(0)="L"
+29 SET X=DTTM
IF X=""
SET X=$$NOW^XLFDT()
+30 SET DLAYGO=90620.05
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+31 IF '$DATA(^BTPWP(DA(1),5,0))
SET ^BTPWP(DA(1),5,0)="^90620.05DA^^"
+32 KILL DO,DD
DO FILE^DICN
+33 SET DA=+Y
+34 ;
+35 ;Set up data
+36 SET BHIST(90620.05,DA_","_DA(1)_",",".02")=USER
+37 SET BHIST(90620.05,DA_","_DA(1)_",",".03")=FILFLD_":"_IEN
+38 SET BHIST(90620.05,DA_","_DA(1)_",",".04")="R"
+39 SET BHIST(90620.05,DA_","_DA(1)_",",".05")=DESC
+40 SET BHIST(90620.05,DA_","_DA(1)_",","101")=CV
+41 SET BHIST(90620.05,DA_","_DA(1)_",","102")=NV
+42 ;
+43 ;Save History
+44 IF $DATA(BHIST)
DO FILE^DIE("","BHIST","ERROR")
End DoDot:1
+45 ;
+46 QUIT
+47 ;
WLOG(NCOM,FILFLD,IEN,USER,DTTM,DESC) ;EP -- Log Change to Tracked File - Word Processing field
+1 ;
+2 NEW BHIST,CCOM,CHG,CVAR,DA,DIC,DLAYGO,FIELD,FILE,I,LST,NVAR,X,Y,ERROR
+3 ;
+4 SET FILE=$PIECE(FILFLD,":")
+5 SET FIELD=$PIECE(FILFLD,":",2)
+6 ;
+7 ;Set up comment reference variable
+8 IF '$DATA(NCOM(1))
SET NVAR="@"
+9 IF '$TEST
SET NVAR="NCOM"
+10 ;
+11 ;Process Save Comment
+12 ;
+13 ;Pull current value
+14 SET CVAR=$$GET1^DIQ(FILE,IEN,FIELD,"","CCOM")
+15 ;
+16 SET CHG=0
SET LST=""
+17 SET I=""
FOR
SET I=$ORDER(CCOM(I))
IF I=""
QUIT
SET LST=I
IF CCOM(I)'=$GET(NCOM(I))
SET CHG=1
QUIT
+18 IF CHG=0
IF $ORDER(NCOM(LST))]""
SET CHG=1
+19 ;
+20 ;No change to comments
+21 IF CHG=0
QUIT
+22 ;
+23 ;Pull Event IEN
+24 SET DA(1)=$PIECE(IEN,",",$LENGTH(IEN,",")-1)
+25 ;
+26 ;Define new entry
+27 SET DIC="^BTPWP("_DA(1)_",5,"
+28 SET DIC(0)="L"
+29 SET X=DTTM
IF X=""
SET X=$$NOW^XLFDT()
+30 SET DLAYGO=90620.05
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+31 IF '$DATA(^BTPWP(DA(1),5,0))
SET ^BTPWP(DA(1),5,0)="^90620.05DA^^"
+32 KILL DO,DD
DO FILE^DICN
+33 SET DA=+Y
+34 ;
+35 ;Set up data
+36 SET BHIST(90620.05,DA_","_DA(1)_",",".02")=USER
+37 SET BHIST(90620.05,DA_","_DA(1)_",",".03")=FILFLD_":"_IEN
+38 SET BHIST(90620.05,DA_","_DA(1)_",",".04")="W"
+39 SET BHIST(90620.05,DA_","_DA(1)_",",".05")=DESC
+40 ;
+41 ;Save History
+42 ;New Comments
IF $DATA(BHIST)
DO FILE^DIE("","BHIST","ERROR")
+43 ;
+44 ;Save comments
+45 ;Save current comments
DO WP^DIE(90620.05,DA_","_DA(1)_",",3,"",CVAR)
+46 ;Save new comments
DO WP^DIE(90620.05,DA_","_DA(1)_",",4,"",NVAR)
+47 QUIT
+48 ;
DLOG(FILE,IENS,USER,DTTM,DESC) ;EP -- Log Deleted Entry Values to History
+1 ;
+2 NEW COM,VAL,RHIST,FIELD
+3 ;
+4 ;Pull existing field information
+5 DO GETS^DIQ(FILE,IENS,"**","I","VAL")
+6 ;
+7 SET FIELD=""
FOR
SET FIELD=$ORDER(VAL(FILE,IENS,FIELD))
IF FIELD=""
QUIT
IF FIELD'=1
SET RHIST(FILE,IENS,FIELD)=""
+8 ;
+9 ;Save regular field history
+10 DO RLOG(.RHIST,USER,DTTM,DESC)
+11 ;
+12 ;Save comment field history
+13 SET COM(1)=""
+14 DO WLOG(.COM,FILE_":1",IENS,USER,DTTM,DESC)
+15 ;
+16 QUIT
+17 ;
SLOG(RIEN,CMIEN,DTTM,USER,DESC) ;EP - Log Status Changes to History
+1 ;
+2 NEW CV,FILFLD,IEN,PVIEN,ERROR
+3 SET (PVIEN,CV)=""
SET FILFLD="90620:.08"
+4 SET IEN=0
FOR
SET IEN=$ORDER(^BTPWQ(RIEN,2,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+5 NEW BHIST,SDATA,NV,LDTTM,LUSER,DA,DIC,DLAYGO,X,Y
+6 SET SDATA=$GET(^BTPWQ(RIEN,2,IEN,0))
+7 ;Status value
SET NV=$PIECE(SDATA,U,2)
+8 ;Status changed date/time
SET LDTTM=$PIECE(SDATA,U,4)
+9 ;Status changed by
SET LUSER=$PIECE(SDATA,U,3)
+10 ;
+11 ;Define new entry
+12 SET DA(1)=CMIEN
+13 SET DIC="^BTPWP("_DA(1)_",5,"
+14 SET DIC(0)="L"
+15 SET X=LDTTM
IF X=""
SET X=$$NOW^XLFDT()
+16 SET DLAYGO=90620.05
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+17 IF '$DATA(^BTPWP(DA(1),5,0))
SET ^BTPWP(DA(1),5,0)="^90620.05DA^^"
+18 KILL DO,DD
DO FILE^DICN
+19 SET DA=+Y
+20 ;
+21 ;Set up data
+22 SET BHIST(90620.05,DA_","_DA(1)_",",".02")=LUSER
+23 SET BHIST(90620.05,DA_","_DA(1)_",",".03")=FILFLD_":"_CMIEN
+24 SET BHIST(90620.05,DA_","_DA(1)_",",".04")="R"
+25 SET BHIST(90620.05,DA_","_DA(1)_",",".05")=DESC
+26 SET BHIST(90620.05,DA_","_DA(1)_",","101")=CV
+27 SET BHIST(90620.05,DA_","_DA(1)_",","102")=NV
+28 ;
+29 ;Save History
+30 IF $DATA(BHIST)
DO FILE^DIE("","BHIST","ERROR")
+31 ;
+32 ;Save Status Comments
+33 DO SWLOG(RIEN,CMIEN,IEN,PVIEN)
+34 ;
+35 ;Save New Value to Current
+36 SET CV=NV
SET PVIEN=IEN
End DoDot:1
+37 ;
+38 KILL BHIST,DA,DIC,ERROR
+39 ;
+40 ;Log current status change
+41 ;
+42 NEW BHIST,DA,DIC,CVAR,PVWP,NVAR,NWP,CHG,LST,I,ERROR
+43 ;Define new entry
+44 SET DA(1)=CMIEN
+45 SET DIC="^BTPWP("_DA(1)_",5,"
+46 SET DIC(0)="L"
+47 SET X=DTTM
IF X=""
SET X=$$NOW^XLFDT()
+48 SET DLAYGO=90620.05
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+49 IF '$DATA(^BTPWP(DA(1),5,0))
SET ^BTPWP(DA(1),5,0)="^90620.05DA^^"
+50 KILL DO,DD
DO FILE^DICN
+51 SET DA=+Y
+52 ;
+53 ;Set up data
+54 SET BHIST(90620.05,DA_","_DA(1)_",",".02")=USER
+55 SET BHIST(90620.05,DA_","_DA(1)_",",".03")=FILFLD_":"_CMIEN
+56 SET BHIST(90620.05,DA_","_DA(1)_",",".04")="R"
+57 SET BHIST(90620.05,DA_","_DA(1)_",",".05")="Event Tracked"
+58 SET BHIST(90620.05,DA_","_DA(1)_",","101")=CV
+59 SET BHIST(90620.05,DA_","_DA(1)_",","102")="T"
+60 ;
+61 ;Save History
+62 IF $DATA(BHIST)
DO FILE^DIE("","BHIST","ERROR")
+63 KILL BHIST,ERROR
+64 ;
+65 ;Log current Event Comment Change
+66 ;
+67 NEW BHIST,ERROR
+68 SET FILE=90620
+69 SET FIELD=4
+70 ;
+71 ;Pull previous history value
+72 IF PVIEN]""
SET CVAR=$$GET1^DIQ(90629.02,PVIEN_","_RIEN_",",1,"","PVWP")
+73 ;
+74 ;Pull current history value
+75 SET NVAR=$$GET1^DIQ(90629,RIEN_",",3,"","NWP")
+76 ;
+77 SET CHG=0
SET LST=""
+78 SET I=""
FOR
SET I=$ORDER(PVWP(I))
IF I=""
QUIT
SET LST=I
IF PVWP(I)'=$GET(NWP(I))
SET CHG=1
QUIT
+79 IF CHG=0
IF $ORDER(NWP(LST))]""
SET CHG=1
+80 ;
+81 ;No change to comments
+82 IF CHG=0
QUIT
+83 ;
+84 ;Pull Event IEN
+85 SET DA(1)=CMIEN
+86 ;
+87 ;Define new entry
+88 SET DIC="^BTPWP("_DA(1)_",5,"
+89 SET DIC(0)="L"
+90 SET X=DTTM
IF X=""
SET X=$$NOW^XLFDT()
+91 SET DLAYGO=90620.05
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+92 IF '$DATA(^BTPWP(DA(1),5,0))
SET ^BTPWP(DA(1),5,0)="^90620.05DA^^"
+93 KILL DO,DD
DO FILE^DICN
+94 SET DA=+Y
+95 ;
+96 ;Set up data
+97 SET BHIST(90620.05,DA_","_DA(1)_",",".02")=USER
+98 SET BHIST(90620.05,DA_","_DA(1)_",",".03")="90620:4:"_CMIEN
+99 SET BHIST(90620.05,DA_","_DA(1)_",",".04")="W"
+100 SET BHIST(90620.05,DA_","_DA(1)_",",".05")="Event Tracked"
+101 ;
+102 ;Save History
+103 ;New Comments
IF $DATA(BHIST)
DO FILE^DIE("","BHIST","ERROR")
+104 ;
+105 ;Save comments
+106 ;Save current comments
DO WP^DIE(90620.05,DA_","_DA(1)_",",3,"",CVAR)
+107 ;Save new comments
DO WP^DIE(90620.05,DA_","_DA(1)_",",4,"",NVAR)
+108 QUIT
+109 ;
SWLOG(RIEN,CMIEN,NIEN,PVIEN) ;Save Status Comment Field History
+1 ;
+2 NEW BHIST,CHG,CVAR,DA,DIC,DLAYGO,FIELD,FILE,I,LST,NVAR,X,Y,PVWP,NWP,SDATA,LDTTM,LUSER,ERROR
+3 ;
+4 SET FILE=90620
+5 SET FIELD=4
+6 ;
+7 ;Pull previous history value
+8 IF PVIEN]""
SET CVAR=$$GET1^DIQ(90629.02,PVIEN_","_RIEN_",",1,"","PVWP")
+9 ;
+10 ;Pull current history value
+11 IF NIEN]""
SET NVAR=$$GET1^DIQ(90629.02,NIEN_","_RIEN_",",1,"","NWP")
+12 ;
+13 SET CHG=0
SET LST=""
+14 SET I=""
FOR
SET I=$ORDER(PVWP(I))
IF I=""
QUIT
SET LST=I
IF PVWP(I)'=$GET(NWP(I))
SET CHG=1
QUIT
+15 IF CHG=0
IF $ORDER(NWP(LST))]""
SET CHG=1
+16 ;
+17 ;No change to comments
+18 IF CHG=0
QUIT
+19 ;
+20 ;Pull Event IEN
+21 SET DA(1)=CMIEN
+22 ;
+23 ;Define new entry
+24 SET SDATA=$GET(^BTPWQ(RIEN,2,NIEN,0))
+25 ;Status changed date/time
SET LDTTM=$PIECE(SDATA,U,4)
+26 ;Status changed by
SET LUSER=$PIECE(SDATA,U,3)
+27 SET DIC="^BTPWP("_DA(1)_",5,"
+28 SET DIC(0)="L"
+29 SET X=LDTTM
IF X=""
SET X=$$NOW^XLFDT()
+30 SET DLAYGO=90620.05
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+31 IF '$DATA(^BTPWP(DA(1),5,0))
SET ^BTPWP(DA(1),5,0)="^90620.05DA^^"
+32 KILL DO,DD
DO FILE^DICN
+33 SET DA=+Y
+34 ;
+35 ;Set up data
+36 SET BHIST(90620.05,DA_","_DA(1)_",",".02")=LUSER
+37 SET BHIST(90620.05,DA_","_DA(1)_",",".03")="90620:4:"_CMIEN
+38 SET BHIST(90620.05,DA_","_DA(1)_",",".04")="W"
+39 SET BHIST(90620.05,DA_","_DA(1)_",",".05")="Status Changes"
+40 ;
+41 ;Save History
+42 ;New Comments
IF $DATA(BHIST)
DO FILE^DIE("","BHIST","ERROR")
+43 ;
+44 ;Save comments
+45 ;Save current comments
DO WP^DIE(90620.05,DA_","_DA(1)_",",3,"",CVAR)
+46 ;Save new comments
DO WP^DIE(90620.05,DA_","_DA(1)_",",4,"",NVAR)
+47 QUIT
+48 ;
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 ;
FLDS ;;
+1 ;;90620;.07;Date/Time Identified;D;
+2 ;;90620;.08;Status;X;;S X=$S(X="P":"PENDING",X="N":"NOT TRACKED",X="E":"EXCEPTION",X="S":"SUPERSEDED",X="T":"TRACKED",1:"")
+3 ;;90620;1.01;Event State;S;
+4 ;;90620;1.02;Event Tracked Date/Time;D;
+5 ;;90620;1.03;Event Tracked By;P;200;
+6 ;;90620;1.04;Close Reason;S;
+7 ;;90620;1.05;Findings Due By;D;
+8 ;;90620;1.06;Follow-up Decision Due By;D;
+9 ;;90620;1.07;Notification Due By;D;
+10 ;;90620;1.09;Last Modified Date/Time;D;
+11 ;;90620;1.1;Last Modified By;P;200;
+12 ;;90620;1.11;Follow-up Recommended?;S;
+13 ;;90620;3;State Comment;W;
+14 ;;90620;4;Event Comment;W;
+15 ;;90620.01;.01;Findings - Date;D;
+16 ;;90620.01;.02;Findings - Result;P;90620.9;
+17 ;;90620.01;.03;Findings - Interpretation;S;
+18 ;;90620.01;.04;Findings - Entered Date/Time;D;
+19 ;;90620.01;.05;Findings - Entered By;P;200;
+20 ;;90620.01;.06;Findings - Follow-Up Needed?;S;
+21 ;;90620.01;.08;Findings - Entered In Error;S;
+22 ;;90620.01;1;Findings - Comment;W;
+23 ;;90620.012;.02;Follow-ups - Event;P;90621;
+24 ;;90620.012;.03;Follow-ups - Date Entered;D;
+25 ;;90620.012;.04;Follow-ups - Entered By;P;200
+26 ;;90620.012;.05;Follow-ups - Date Due;D;
+27 ;;90620.012;.07;Follow-ups - Entered In Error;S;
+28 ;;90620.012;1;Follow-ups - Comment;W;
+29 ;;90620.011;.01;Notifications - Date;D;
+30 ;;90620.011;.02;Notifications - Method;P;90622;
+31 ;;90620.011;.03;Notifications - Entry Date;D;
+32 ;;90620.011;.04;Notifications - Entered By;P;200;
+33 ;;90620.011;.05;Notifications - Document;P;8925;
+34 ;;90620.011;.06;Notifications - TIU Document;P;8927.1;
+35 ;;90620.011;.07;Notifications - TIU Template;P;8927;
+36 ;;90620.011;.09;Notifications - Entered In Error;S;
+37 ;;90620.011;.1;Notifications - Addendum;P;8925;
+38 ;;90620.011;1;Notifications - Comment;W;
+39 ;;
