- 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
