BTPWHIST.m

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