VAFCAUD ;BIR/CML-MPI/PD AUDIT FILE PRINT FOR A SPECIFIED PATIENT ;2/25/09
;;5.3;PIMS;**477,1016**;JUN 30, 2012;Build 20
;Reference to ^DIA(2 and data derived from the AUDIT file (#1.1)
;is supported by IA #2097 and #2602.
;Reference to ^ORD(101 supported by IA #2596
S QFLG=1
S RPCFLG=0 ;is this from an rpc call
BEGIN ;
W !!,"This option prints information from the AUDIT file (#1.1) for a"
W !,"selected patient and date range."
W !!,"For the PATIENT file (#2) entry selected, the report prints the"
W !,"patient name and DFN, date/time the field was edited, the user who"
W !,"made the change, the field edited, the old value, and the new value."
W !,"The option or protocol (if available) will also be displayed."
D ASK1
I $G(VAFCDFN) D ASK2
I $G(VAFCBDT),$G(VAFCEDT) D DEV
G QUIT
;
ASK1 ;Ask for PATIENT
W !
S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: " D ^DIC K DIC Q:Y<0 S VAFCDFN=+Y
I '$O(^DIA(2,"B",VAFCDFN,0)),'$O(^DIA(2,"B",VAFCDFN_",1",0)) W !!,"This patient has no audit data available for any date." G ASK1 ;**712
Q
;
ASK2 ;Ask for Date Range
;I '$D(VAFCDFN)&($D(DFN)) S VAFCDFN=DFN
W !!,"Enter date range for data to be included in report."
K DIR,DIRUT,DTOUT,DUOUT
S DIR(0)="DAO^:DT:EPX",DIR("A")="Beginning Date: " D ^DIR K DIR Q:$D(DIRUT) S VAFCBDT=Y
S DIR(0)="DAO^"_VAFCBDT_":DT:EPX",DIR("A")="Ending Date: " D ^DIR K DIR Q:$D(DIRUT) S VAFCEDT=Y
Q
;
DEV W !!,"The right margin for this report is 80.",!!
S ZTSAVE("VAFCBDT")="",ZTSAVE("VAFCEDT")="",ZTSAVE("VAFCDFN")=""
D EN^XUTMDEVQ("START^VAFCAUD(VAFCDFN,VAFCBDT,VAFCEDT,RPCFLG)","MPI/PD - Print AUDIT File Data for a Specific Patient",.ZTSAVE) I 'POP Q
W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
G QUIT
;
START(VAFCDFN,VAFCBDT,VAFCEDT,RPCFLG) ;
N IEN
K ^TMP("VAFCAUD",$J)
;
LOOP ;Loop on "B" xref of the AUDIT file
S STOP=VAFCEDT+1
S IEN=0 F S IEN=$O(^DIA(2,"B",VAFCDFN,IEN)) Q:'IEN D
.I $D(^DIA(2,IEN,0)) S EDITDT=$P(^(0),U,2) I EDITDT>VAFCBDT,EDITDT<STOP D
..S ^TMP("VAFCAUD",$J,EDITDT,IEN)=""
;
;find any audit data for audited fields that are multiples - **712
F QQ=1:1 S SUB=VAFCDFN_","_QQ Q:'$D(^DIA(2,"B",SUB)) S IEN=0 F S IEN=$O(^DIA(2,"B",SUB,IEN)) Q:'IEN D
.I $D(^DIA(2,IEN,0)) S EDITDT=$P(^(0),U,2) I EDITDT>VAFCBDT,EDITDT<STOP S ^TMP("VAFCAUD",$J,EDITDT,IEN)=""
;
PRT ;Print report
S (PG,QFLG)=0,U="^",$P(LN,"-",81)="",SITE=$P($$SITE^VASITE(),U,2)
S PVAFCBDT=$$FMTE^XLFDT(VAFCBDT),PVAFCEDT=$$FMTE^XLFDT(VAFCEDT)
D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
D HDR
I '$O(^TMP("VAFCAUD",$J,0)) W !!,"No audit data found in this date range for this patient." Q
S EDITDT=0 F S EDITDT=$O(^TMP("VAFCAUD",$J,EDITDT)) Q:QFLG Q:'EDITDT D
.S IEN=0 F S IEN=$O(^TMP("VAFCAUD",$J,EDITDT,IEN)) Q:QFLG Q:'IEN D
..S PRTDT=$$FMTE^XLFDT($E(EDITDT,1,12))
..S IEN0=^DIA(2,IEN,0)
..S FILE=2,FIELD=$P(IEN0,"^",3) I FIELD["," S FILE=+$P(^DD(2,$P(FIELD,","),0),"^",2),FIELD=$P(FIELD,",",2) ;**712
..K VAFCARR1 D FIELD^DID(FILE,FIELD,"","LABEL","VAFCARR1") ;**712
..S FLD=$G(VAFCARR1("LABEL")) Q:FLD=""
..S USER=$P(IEN0,U,4)
..I 'USER S USER="UNKNOWN"
..I USER'="UNKNOWN" S DIC="^VA(200,",DIC(0)="MZO",X="`"_USER D ^DIC S USER=$P(Y,"^",2)
..S OLD=$G(^DIA(2,IEN,2)) I OLD']"" S OLD="<no previous value>"
..S NEW=$G(^DIA(2,IEN,3)) I NEW']"" S NEW="<no current value>"
..K OPTDA1,OPTDA2,VAFCOPTN,OPTNM I $G(^DIA(2,IEN,4.1)) D
...S OPTDA1=+$P(^DIA(2,IEN,4.1),"^")
...I OPTDA1 S DIC=19,DR=".01",DA=OPTDA1,DIQ(0)="EI",DIQ="VAFCOPTN" D EN^DIQ1 K DIC,DR,DA,DIQ S VAFCOPTN=$G(VAFCOPTN(19,OPTDA1,.01,"E"))
...S OPTDA2=$P(^DIA(2,IEN,4.1),"^",2)
...I $P(OPTDA2,";",2)="ORD(101," S DIC=101,DR=".01",DA=+OPTDA2,DIQ(0)="EI",DIQ="VAFCOPTN" D EN^DIQ1 K DIC,DR,DA,DIQ S OPTNM=$G(VAFCOPTN(101,+OPTDA2,.01,"E")) Q
...I +OPTDA2 S DIC=19,DR=".01",DA=+OPTDA2,DIQ(0)="EI",DIQ="VAFCOPTN" D EN^DIQ1 K DIC,DR,DA,DIQ S OPTNM=$G(VAFCOPTN(19,+OPTDA2,.01,"E")) Q
..I 'RPCFLG D:$Y+4>IOSL HDR Q:QFLG
..W !,PRTDT,?20,FLD,?51,USER,!?20,OLD," / ",NEW
..I $G(VAFCOPTN)'="" W !?3,VAFCOPTN
..I $G(OPTNM)'="" W:$G(VAFCOPTN)="" !?3 W "/",$G(OPTNM)
..W !
Q
;
QUIT ;
I '$G(RPCFLG),$E(IOST,1,2)="C-"&('$G(QFLG)) S DIR(0)="E" D D ^DIR K DIR
.S SS=22-$Y F JJ=1:1:SS W !
I '$G(RPCFLG) D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
K ^TMP("VAFCAUD",$J)
K %,%I,C,VAFCDFN,EDITDT,FLD,HDT,IEN,IEN0,JJ,LN,NEW,OLD,OPTDA1,OPTDA2,VAFCOPTN,OPTNM,PG,PVAFCBDT,PVAFCEDT,PRTDT,POP
K QFLG,VAFCARR1,VAFCBDT,VAFCEDT,RPCFLG,SITE,SS,STOP,USER,X,Y,ZTSK
K SUB,FILE,FIELD,QQ ;**712
Q
;
HDR ;HEADER
I 'RPCFLG I $E(IOST,1,2)="C-" S SS=22-$Y F JJ=1:1:SS W !
I 'RPCFLG I $E(IOST,1,2)="C-",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
S PG=PG+1
I 'RPCFLG W:$Y!($E(IOST,1,2)="C-") @IOF
W !,"PATIENT AUDIT LIST at ",SITE," on ",HDT,?70,"Page: ",PG
W !,"Patient: ",$P(^DPT(VAFCDFN,0),U)," (DFN #",VAFCDFN,")"
W !,"Date Range: ",PVAFCBDT," to ",PVAFCEDT
W !!,"Date/Time Edited",?20,"Field Edited",?51,"Edited By"
W !?20,"Old Value / New Value",!?3,"Option/Protocol",!,LN
Q
VAFCAUD ;BIR/CML-MPI/PD AUDIT FILE PRINT FOR A SPECIFIED PATIENT ;2/25/09
+1 ;;5.3;PIMS;**477,1016**;JUN 30, 2012;Build 20
+2 ;Reference to ^DIA(2 and data derived from the AUDIT file (#1.1)
+3 ;is supported by IA #2097 and #2602.
+4 ;Reference to ^ORD(101 supported by IA #2596
+5 SET QFLG=1
+6 ;is this from an rpc call
SET RPCFLG=0
BEGIN ;
+1 WRITE !!,"This option prints information from the AUDIT file (#1.1) for a"
+2 WRITE !,"selected patient and date range."
+3 WRITE !!,"For the PATIENT file (#2) entry selected, the report prints the"
+4 WRITE !,"patient name and DFN, date/time the field was edited, the user who"
+5 WRITE !,"made the change, the field edited, the old value, and the new value."
+6 WRITE !,"The option or protocol (if available) will also be displayed."
+7 DO ASK1
+8 IF $GET(VAFCDFN)
DO ASK2
+9 IF $GET(VAFCBDT)
IF $GET(VAFCEDT)
DO DEV
+10 GOTO QUIT
+11 ;
ASK1 ;Ask for PATIENT
+1 WRITE !
+2 SET DIC="^DPT("
SET DIC(0)="QEAM"
SET DIC("A")="Select PATIENT: "
DO ^DIC
KILL DIC
IF Y<0
QUIT
SET VAFCDFN=+Y
+3 ;**712
IF '$ORDER(^DIA(2,"B",VAFCDFN,0))
IF '$ORDER(^DIA(2,"B",VAFCDFN_",1",0))
WRITE !!,"This patient has no audit data available for any date."
GOTO ASK1
+4 QUIT
+5 ;
ASK2 ;Ask for Date Range
+1 ;I '$D(VAFCDFN)&($D(DFN)) S VAFCDFN=DFN
+2 WRITE !!,"Enter date range for data to be included in report."
+3 KILL DIR,DIRUT,DTOUT,DUOUT
+4 SET DIR(0)="DAO^:DT:EPX"
SET DIR("A")="Beginning Date: "
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
SET VAFCBDT=Y
+5 SET DIR(0)="DAO^"_VAFCBDT_":DT:EPX"
SET DIR("A")="Ending Date: "
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
SET VAFCEDT=Y
+6 QUIT
+7 ;
DEV WRITE !!,"The right margin for this report is 80.",!!
+1 SET ZTSAVE("VAFCBDT")=""
SET ZTSAVE("VAFCEDT")=""
SET ZTSAVE("VAFCDFN")=""
+2 DO EN^XUTMDEVQ("START^VAFCAUD(VAFCDFN,VAFCBDT,VAFCEDT,RPCFLG)","MPI/PD - Print AUDIT File Data for a Specific Patient",.ZTSAVE)
IF 'POP
QUIT
+3 WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
+4 GOTO QUIT
+5 ;
START(VAFCDFN,VAFCBDT,VAFCEDT,RPCFLG) ;
+1 NEW IEN
+2 KILL ^TMP("VAFCAUD",$JOB)
+3 ;
LOOP ;Loop on "B" xref of the AUDIT file
+1 SET STOP=VAFCEDT+1
+2 SET IEN=0
FOR
SET IEN=$ORDER(^DIA(2,"B",VAFCDFN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+3 IF $DATA(^DIA(2,IEN,0))
SET EDITDT=$PIECE(^(0),U,2)
IF EDITDT>VAFCBDT
IF EDITDT<STOP
Begin DoDot:2
+4 SET ^TMP("VAFCAUD",$JOB,EDITDT,IEN)=""
End DoDot:2
End DoDot:1
+5 ;
+6 ;find any audit data for audited fields that are multiples - **712
+7 FOR QQ=1:1
SET SUB=VAFCDFN_","_QQ
IF '$DATA(^DIA(2,"B",SUB))
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^DIA(2,"B",SUB,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+8 IF $DATA(^DIA(2,IEN,0))
SET EDITDT=$PIECE(^(0),U,2)
IF EDITDT>VAFCBDT
IF EDITDT<STOP
SET ^TMP("VAFCAUD",$JOB,EDITDT,IEN)=""
End DoDot:1
+9 ;
PRT ;Print report
+1 SET (PG,QFLG)=0
SET U="^"
SET $PIECE(LN,"-",81)=""
SET SITE=$PIECE($$SITE^VASITE(),U,2)
+2 SET PVAFCBDT=$$FMTE^XLFDT(VAFCBDT)
SET PVAFCEDT=$$FMTE^XLFDT(VAFCEDT)
+3 DO NOW^%DTC
SET HDT=$$FMTE^XLFDT($EXTRACT(%,1,12))
+4 DO HDR
+5 IF '$ORDER(^TMP("VAFCAUD",$JOB,0))
WRITE !!,"No audit data found in this date range for this patient."
QUIT
+6 SET EDITDT=0
FOR
SET EDITDT=$ORDER(^TMP("VAFCAUD",$JOB,EDITDT))
IF QFLG
QUIT
IF 'EDITDT
QUIT
Begin DoDot:1
+7 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("VAFCAUD",$JOB,EDITDT,IEN))
IF QFLG
QUIT
IF 'IEN
QUIT
Begin DoDot:2
+8 SET PRTDT=$$FMTE^XLFDT($EXTRACT(EDITDT,1,12))
+9 SET IEN0=^DIA(2,IEN,0)
+10 ;**712
SET FILE=2
SET FIELD=$PIECE(IEN0,"^",3)
IF FIELD[","
SET FILE=+$PIECE(^DD(2,$PIECE(FIELD,","),0),"^",2)
SET FIELD=$PIECE(FIELD,",",2)
+11 ;**712
KILL VAFCARR1
DO FIELD^DID(FILE,FIELD,"","LABEL","VAFCARR1")
+12 SET FLD=$GET(VAFCARR1("LABEL"))
IF FLD=""
QUIT
+13 SET USER=$PIECE(IEN0,U,4)
+14 IF 'USER
SET USER="UNKNOWN"
+15 IF USER'="UNKNOWN"
SET DIC="^VA(200,"
SET DIC(0)="MZO"
SET X="`"_USER
DO ^DIC
SET USER=$PIECE(Y,"^",2)
+16 SET OLD=$GET(^DIA(2,IEN,2))
IF OLD']""
SET OLD="<no previous value>"
+17 SET NEW=$GET(^DIA(2,IEN,3))
IF NEW']""
SET NEW="<no current value>"
+18 KILL OPTDA1,OPTDA2,VAFCOPTN,OPTNM
IF $GET(^DIA(2,IEN,4.1))
Begin DoDot:3
+19 SET OPTDA1=+$PIECE(^DIA(2,IEN,4.1),"^")
+20 IF OPTDA1
SET DIC=19
SET DR=".01"
SET DA=OPTDA1
SET DIQ(0)="EI"
SET DIQ="VAFCOPTN"
DO EN^DIQ1
KILL DIC,DR,DA,DIQ
SET VAFCOPTN=$GET(VAFCOPTN(19,OPTDA1,.01,"E"))
+21 SET OPTDA2=$PIECE(^DIA(2,IEN,4.1),"^",2)
+22 IF $PIECE(OPTDA2,";",2)="ORD(101,"
SET DIC=101
SET DR=".01"
SET DA=+OPTDA2
SET DIQ(0)="EI"
SET DIQ="VAFCOPTN"
DO EN^DIQ1
KILL DIC,DR,DA,DIQ
SET OPTNM=$GET(VAFCOPTN(101,+OPTDA2,.01,"E"))
QUIT
+23 IF +OPTDA2
SET DIC=19
SET DR=".01"
SET DA=+OPTDA2
SET DIQ(0)="EI"
SET DIQ="VAFCOPTN"
DO EN^DIQ1
KILL DIC,DR,DA,DIQ
SET OPTNM=$GET(VAFCOPTN(19,+OPTDA2,.01,"E"))
QUIT
End DoDot:3
+24 IF 'RPCFLG
IF $Y+4>IOSL
DO HDR
IF QFLG
QUIT
+25 WRITE !,PRTDT,?20,FLD,?51,USER,!?20,OLD," / ",NEW
+26 IF $GET(VAFCOPTN)'=""
WRITE !?3,VAFCOPTN
+27 IF $GET(OPTNM)'=""
IF $GET(VAFCOPTN)=""
WRITE !?3
WRITE "/",$GET(OPTNM)
+28 WRITE !
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
QUIT ;
+1 IF '$GET(RPCFLG)
IF $EXTRACT(IOST,1,2)="C-"&('$GET(QFLG))
SET DIR(0)="E"
Begin DoDot:1
+2 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
End DoDot:1
DO ^DIR
KILL DIR
+3 IF '$GET(RPCFLG)
DO ^%ZISC
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 KILL ^TMP("VAFCAUD",$JOB)
+5 KILL %,%I,C,VAFCDFN,EDITDT,FLD,HDT,IEN,IEN0,JJ,LN,NEW,OLD,OPTDA1,OPTDA2,VAFCOPTN,OPTNM,PG,PVAFCBDT,PVAFCEDT,PRTDT,POP
+6 KILL QFLG,VAFCARR1,VAFCBDT,VAFCEDT,RPCFLG,SITE,SS,STOP,USER,X,Y,ZTSK
+7 ;**712
KILL SUB,FILE,FIELD,QQ
+8 QUIT
+9 ;
HDR ;HEADER
+1 IF 'RPCFLG
IF $EXTRACT(IOST,1,2)="C-"
SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+2 IF 'RPCFLG
IF $EXTRACT(IOST,1,2)="C-"
IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+3 SET PG=PG+1
+4 IF 'RPCFLG
IF $Y!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+5 WRITE !,"PATIENT AUDIT LIST at ",SITE," on ",HDT,?70,"Page: ",PG
+6 WRITE !,"Patient: ",$PIECE(^DPT(VAFCDFN,0),U)," (DFN #",VAFCDFN,")"
+7 WRITE !,"Date Range: ",PVAFCBDT," to ",PVAFCEDT
+8 WRITE !!,"Date/Time Edited",?20,"Field Edited",?51,"Edited By"
+9 WRITE !?20,"Old Value / New Value",!?3,"Option/Protocol",!,LN
+10 QUIT
