1 | RGMTAUD ;BIR/CML-MPI/PD AUDIT FILE PRINT FOR A SPECIFIED PATIENT ;01/06/99
|
---|
2 | ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,19,20,30**;30 Apr 99
|
---|
3 | ;Reference to ^DIA(2 and data derived from the AUDIT file (#1.1)
|
---|
4 | ;is supported by IA #2097 and #2602.
|
---|
5 | ;Reference to ^ORD(101 supported by IA #2596
|
---|
6 | S QFLG=1
|
---|
7 | BEGIN ;
|
---|
8 | W !!,"This option prints information from the AUDIT file (#1.1) for a"
|
---|
9 | W !,"selected patient and date range."
|
---|
10 | W !!,"For the PATIENT file (#2) entry selected, the report prints the"
|
---|
11 | W !,"patient name and DFN, date/time the field was edited, the user who"
|
---|
12 | W !,"made the change, the field edited, the old value, and the new value."
|
---|
13 | W !,"The option or protocol (if available) will also be displayed."
|
---|
14 | ;
|
---|
15 | ASK1 ;Ask for PATIENT
|
---|
16 | W !
|
---|
17 | S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: " D ^DIC K DIC G:Y<0 QUIT S RGDFN=+Y
|
---|
18 | I '$O(^DIA(2,"B",RGDFN,0)) W !!,"This patient has no audit data available for any date." G ASK1
|
---|
19 | ;
|
---|
20 | ASK2 ;Ask for Date Range
|
---|
21 | I '$D(RGDFN)&($D(DFN)) S RGDFN=DFN
|
---|
22 | W !!,"Enter date range for data to be included in report."
|
---|
23 | K DIR,DIRUT,DTOUT,DUOUT S DIR(0)="DAO^:DT:EPX",DIR("A")="Beginning Date: " D ^DIR K DIR G:$D(DIRUT) QUIT
|
---|
24 | S RGBDT=Y,DIR(0)="DAO^"_RGBDT_":DT:EPX",DIR("A")="Ending Date: " D ^DIR K DIR G:$D(DIRUT) QUIT S RGEDT=Y
|
---|
25 | ;
|
---|
26 | DEV W !!,"The right margin for this report is 80.",!!
|
---|
27 | S ZTSAVE("RGBDT")="",ZTSAVE("RGEDT")="",ZTSAVE("RGDFN")=""
|
---|
28 | D EN^XUTMDEVQ("START^RGMTAUD","MPI/PD - Print AUDIT File Data for a Specific Patient",.ZTSAVE) I 'POP Q
|
---|
29 | W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
|
---|
30 | G QUIT
|
---|
31 | ;
|
---|
32 | START ;
|
---|
33 | K ^TMP("RGMTAUD",$J) S U="^"
|
---|
34 | ;
|
---|
35 | LOOP ;Loop on "B" xref of the AUDIT file
|
---|
36 | S STOP=RGEDT+1
|
---|
37 | S IEN=0 F S IEN=$O(^DIA(2,"B",RGDFN,IEN)) Q:'IEN D
|
---|
38 | .I $D(^DIA(2,IEN,0)) S EDITDT=$P(^(0),U,2) I EDITDT>RGBDT,EDITDT<STOP D
|
---|
39 | ..S ^TMP("RGMTAUD",$J,EDITDT,IEN)=""
|
---|
40 | ;
|
---|
41 | PRT ;Print report
|
---|
42 | S (PG,QFLG)=0,U="^",$P(LN,"-",81)="",SITE=$P($$SITE^VASITE(),U,2)
|
---|
43 | S PRGBDT=$$FMTE^XLFDT(RGBDT),PRGEDT=$$FMTE^XLFDT(RGEDT)
|
---|
44 | D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
|
---|
45 | D HDR
|
---|
46 | I '$O(^TMP("RGMTAUD",$J,0)) W !!,"No audit data found in this date range for this patient." G QUIT
|
---|
47 | S EDITDT=0 F S EDITDT=$O(^TMP("RGMTAUD",$J,EDITDT)) Q:QFLG Q:'EDITDT D
|
---|
48 | .S IEN=0 F S IEN=$O(^TMP("RGMTAUD",$J,EDITDT,IEN)) Q:QFLG Q:'IEN D
|
---|
49 | ..S PRTDT=$$FMTE^XLFDT($E(EDITDT,1,12))
|
---|
50 | ..S IEN0=^DIA(2,IEN,0)
|
---|
51 | ..K RGARR D FIELD^DID(2,$P(IEN0,U,3),"","LABEL","RGARR")
|
---|
52 | ..S FLD=$G(RGARR("LABEL")) Q:FLD=""
|
---|
53 | ..S USER=$P(IEN0,U,4)
|
---|
54 | ..I 'USER S USER="UNKNOWN"
|
---|
55 | ..I USER'="UNKNOWN" S DIC="^VA(200,",DIC(0)="MZO",X="`"_USER D ^DIC S USER=$P(Y,"^",2)
|
---|
56 | ..S OLD=$G(^DIA(2,IEN,2)) I OLD']"" S OLD="<no previous value>"
|
---|
57 | ..S NEW=$G(^DIA(2,IEN,3)) I NEW']"" S NEW="<no current value>"
|
---|
58 | ..K OPTDA1,OPTDA2,RGOPTN,OPTNM I $G(^DIA(2,IEN,4.1)) D
|
---|
59 | ...S OPTDA1=+$P(^DIA(2,IEN,4.1),"^")
|
---|
60 | ...I OPTDA1 S DIC=19,DR=".01",DA=OPTDA1,DIQ(0)="EI",DIQ="RGOPTN" D EN^DIQ1 K DIC,DR,DA,DIQ S RGOPTN=$G(RGOPTN(19,OPTDA1,.01,"E"))
|
---|
61 | ...S OPTDA2=$P(^DIA(2,IEN,4.1),"^",2)
|
---|
62 | ...I $P(OPTDA2,";",2)="ORD(101," S DIC=101,DR=".01",DA=+OPTDA2,DIQ(0)="EI",DIQ="RGOPTN" D EN^DIQ1 K DIC,DR,DA,DIQ S OPTNM=$G(RGOPTN(101,+OPTDA2,.01,"E")) Q
|
---|
63 | ...I +OPTDA2 S DIC=19,DR=".01",DA=+OPTDA2,DIQ(0)="EI",DIQ="RGOPTN" D EN^DIQ1 K DIC,DR,DA,DIQ S OPTNM=$G(RGOPTN(19,+OPTDA2,.01,"E")) Q
|
---|
64 | ..D:$Y+4>IOSL HDR Q:QFLG W !!,PRTDT,?20,FLD,?51,USER,!?20,OLD," / ",NEW
|
---|
65 | ..I $G(RGOPTN)'="" W !?3,RGOPTN ;**20
|
---|
66 | ..I $G(OPTNM)'="" W:$G(RGOPTN)="" !?3 W "/",$G(OPTNM) ;**20
|
---|
67 | ;
|
---|
68 | QUIT ;
|
---|
69 | I $E(IOST,1,2)="C-"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
|
---|
70 | .S SS=22-$Y F JJ=1:1:SS W !
|
---|
71 | K ^TMP("RGMTAUD",$J)
|
---|
72 | K %,%I,DFN,C,RGDFN,EDITDT,FLD,HDT,IEN,IEN0,JJ,LN,NEW,OLD,OPTDA1,OPTDA2,RGOPTN,OPTNM,PG,PRGBDT,PRGEDT,PRTDT
|
---|
73 | K QFLG,RGARR,RGBDT,RGEDT,SITE,SS,STOP,USER,X,Y,ZTSK
|
---|
74 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
|
---|
75 | ;
|
---|
76 | HDR ;HEADER
|
---|
77 | I $E(IOST,1,2)="C-" S SS=22-$Y F JJ=1:1:SS W !
|
---|
78 | I $E(IOST,1,2)="C-",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
|
---|
79 | S PG=PG+1 W:$Y!($E(IOST,1,2)="C-") @IOF
|
---|
80 | W !,"PATIENT AUDIT LIST at ",SITE," on ",HDT,?72,"Page: ",PG
|
---|
81 | W !,"Patient: ",$P(^DPT(RGDFN,0),U)," (DFN #",RGDFN,")"
|
---|
82 | W !,"Date Range: ",PRGBDT," to ",PRGEDT
|
---|
83 | W !!,"Date/Time Edited",?20,"Field Edited",?51,"Edited By"
|
---|
84 | W !?20,"Old Value / New Value",!?3,"Option/Protocol",!,LN
|
---|
85 | Q
|
---|