source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCAUD.m@ 1697

Last change on this file since 1697 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

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