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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1DGPREP5 ;ALB/SCK - PreRegistration Audit field totals ; 10/10/03 3:16pm
2 ;;5.3;Registration;**109,555**;Aug 13, 1993
3 Q
4EN ; Entry point for audit totals by user
5 N DGPBEG,DGPEND,VAUTD,DGPFLD1,DGPDSH,DGPABRT,DGPLN
6 K DIR,DIRUT
7 ;
8 S DIR(0)="DA^::EX"
9 S X1=$P($$NOW^XLFDT,".")
10 S DIR("?",1)="Enter the beginning or ending date in an acceptable format"
11 S DIR("?")="The ending date cannot be before the beginning date."
12 S DIR("B")=$$FMTE^XLFDT(X1,1)
13 S DIR("A")="Enter beginning date for report: "
14 D ^DIR
15 I $D(DIRUT) G EXIT
16 S DGPBEG=Y
17 S DIR("A")="Enter ending date for report: "
18 ;
19AGN D ^DIR
20 I $D(DIRUT) G EXIT
21 S DGPEND=Y
22 I DGPEND<DGPBEG D G AGN
23 . W !,"The ending date for this report cannot be earlier then the beginning date"
24 ;
25 K DIR
26 ;
27 S %ZIS="Q" D ^%ZIS G:POP EXIT
28 I $D(IO("Q")) D G EXIT
29 . S ZTRTN="RPT^DGPREP5",ZTDESC="DISPLAY AUDIT FILE TOTALS BY USER"
30 . S ZTSAVE("DGPBEG")="",ZTSAVE("DGPEND")=""
31 . S ZTSAVE("VAUTD(")="",ZTSAVE("VAUTD")=""
32 . D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
33 . D HOME^%ZIS
34 . K IO("Q"),ZTSK,ZTDESC,ZTRTN,ZTSAVE
35 ;
36 D WAIT^DICD
37 ;
38RPT ; Call procedures to build the data arrays, and then call the print procedure
39 U IO
40 S $P(DGPDSH,"=",79)=""
41 S $P(DGPLN,"-",60)=""
42 ;
43 K ^TMP("DGPAUD",$J)
44 K ^TMP("DGPTOT",$J)
45 ;
46 D BLD2
47 D BLD3
48 ;
49 D PRNT(2)
50 G:$G(DGPABRT) EXIT
51 D PRNT(2.312)
52 G:$G(DGPABRT) EXIT
53 D TOT
54 ;
55EXIT ; Clean up and exit
56 D:'$D(ZTQUEUED) ^%ZISC
57 K ^TMP("DGPAUD",$J),POP,ZTQUEUED
58 Q
59 ;
60BLD2 ; Build array of audit data for the PATIENT File, #2
61 N DGPN1,DGPFLD,DGPDATA,DGPDUZ,DGPN2
62 ;
63 S DGPN1=0
64 F S DGPN1=$O(^DD(2,DGPN1)) Q:'DGPN1 D
65 . I $G(^DD(2,DGPN1,"AUDIT"))="y" S DGPFLD(DGPN1)=""
66 ;
67 S DGPN1=DGPBEG-.1
68 S DGPE=DGPEND+.999999
69 F S DGPN1=$O(^DIA(2,"C",DGPN1)) Q:'DGPN1!(DGPN1>DGPE) D
70 . S DGPN2="" F S DGPN2=$O(^DIA(2,"C",DGPN1,DGPN2)) Q:'DGPN2 D
71 .. S DGPDATA=$G(^DIA(2,DGPN2,0))
72 .. Q:$P(DGPDATA,U,3)=""
73 .. Q:'$D(DGPFLD(+$P($G(DGPDATA),U,3)))
74 .. S DGPDUZ=+$P($G(DGPDATA),U,4) Q:DGPDUZ'>0
75 .. Q:'($D(^XUSEC("DGPRE EDIT",DGPDUZ))!($D(^XUSEC("DGPRE SUPV",DGPDUZ))))
76 .. S ^TMP("DGPAUD",$J,2,+$P(DGPDATA,U,3),DGPDUZ)=+$G(^TMP("DGPAUD",$J,2,+$P(DGPDATA,U,3),DGPDUZ))+1
77 .. S ^TMP("DGPTOT",$J,DGPDUZ)=+$G(^TMP("DGPTOT",$J,DGPDUZ))+1
78 Q
79 ;
80BLD3 ; Build array of audit data for file 2.312
81 N DGPN1,DGPE,DGPDATA,DGPDUZ,DGPN2
82 ;
83 S DGPN1=0
84 F S DGPN1=$O(^DD(2.312,DGPN1)) Q:'DGPN1 D
85 . I $G(^DD(2.312,DGPN1,"AUDIT"))="y" S DGPFLD(".3121,"_DGPN1)=""
86 ;
87 S DGPN1=DGPBEG-.1
88 S DGPE=DGPEND+.999999
89 F S DGPN1=$O(^DIA(2,"C",DGPN1)) Q:'DGPN1!(DGPN1>DGPE) D
90 . S DGPN2="" F S DGPN2=$O(^DIA(2,"C",DGPN1,DGPN2)) Q:'DGPN2 D
91 .. S DGPDATA=$G(^DIA(2,DGPN2,0))
92 .. Q:$P(DGPDATA,U,3)=""
93 .. Q:'$D(DGPFLD($P($G(DGPDATA),U,3)))
94 .. S DGPDUZ=+$P($G(DGPDATA),U,4) Q:DGPDUZ'>0
95 .. Q:'($D(^XUSEC("DGPRE EDIT",DGPDUZ))!($D(^XUSEC("DGPRE SUPV",DGPDUZ))))
96 .. S ^TMP("DGPAUD",$J,2.312,$P(DGPDATA,U,3),DGPDUZ)=+$G(^TMP("DGPAUD",$J,2.312,$P(DGPDATA,U,3),DGPDUZ))+1
97 .. S ^TMP("DGPTOT",$J,DGPDUZ)=+$G(^TMP("DGPTOT",$J,DGPDUZ))+1
98 ;
99 Q
100 ;
101PRNT(DGPDD) ; Print the report
102 N DGPFLDX,DGPIENX,DGPTOT
103 ;
104 S X=$$NEWPGE Q:$G(DGPABRT)
105 D HDR(DGPDD)
106 I '$D(^TMP("DGPAUD",$J,DGPDD)) D Q
107 . W !!?5,"No audit data for this date range"
108 ;
109 S DGPFLDX=""
110 F S DGPFLDX=$O(^TMP("DGPAUD",$J,DGPDD,DGPFLDX)) Q:'DGPFLDX D Q:$G(DGPABRT)
111 . D HDR1(DGPDD,DGPFLDX)
112 . S DGPIENX="" F S DGPIENX=$O(^TMP("DGPAUD",$J,DGPDD,DGPFLDX,DGPIENX)) Q:'DGPIENX D Q:$G(DGPABRT)
113 .. I $Y>(IOSL-8) D:$$NEWPGE HDR(DGPDD) Q:$G(DGPABRT)
114 .. W !?5,$P(^VA(200,DGPIENX,0),U),": ",?50,$J(^TMP("DGPAUD",$J,DGPDD,DGPFLDX,DGPIENX),6)
115 .. S DGPTOT=$G(DGPTOT)+$G(^TMP("DGPAUD",$J,DGPDD,DGPFLDX,DGPIENX))
116 . Q:$G(DGPABRT)
117 . W !!?5,$P(^DD(DGPDD,$S(DGPDD=2:DGPFLDX,1:$P(DGPFLDX,",",2)),0),U)_" (TOTAL): ",?50,$J(DGPTOT,6)
118 . S DGPTOT=0
119 . W !?5,DGPLN,!
120 Q
121 ;
122TOT ; Display totals by user
123 S X=$$NEWPGE Q:$G(DGPABRT)
124 D HDR(0)
125 W !!,?2,"User Totals"
126 W !?2,DGPDSH
127 S DGPIENX="",DGPTOT=0
128 F S DGPIENX=$O(^TMP("DGPTOT",$J,DGPIENX)) Q:'DGPIENX D G:$G(DGPABRT) EXIT
129 . I $Y>(IOSL-8) D:$$NEWPGE HDR(0) Q:$G(DGPABRT)
130 . W !?5,$P(^VA(200,DGPIENX,0),U),?50,$J(+$G(^TMP("DGPTOT",$J,DGPIENX)),5)
131 . S DGPTOT=$G(DGPTOT)++$G(^TMP("DGPTOT",$J,DGPIENX))
132 ;
133 W !!?5,"Total Changes: ",?50,$J(DGPTOT,5)
134 ;
135 Q
136 ;
137HDR(DGPDD) ; Page header
138 W @IOF
139 W !?2,"Pre-Registration Audit Totals"
140 W !?2,"For Period Covering "_$$FMTE^XLFDT(DGPBEG,"2D")_" to "_$$FMTE^XLFDT(DGPEND,"2D")
141 W !?2,DGPDSH
142 W !!,?2,$S(DGPDD=2:"Patient Demographic Data --",DGPDD=2.312:"Patient Insurance Data",1:"")
143 ;
144 Q
145 ;
146HDR1(DGPDD,DFLD) ; Field header
147 I $Y>(IOSL-8) D:$$NEWPGE HDR(DGPDD) G:$G(DGPABRT) EXIT
148 W !!?5,"**** Field: ",$P(^DD(DGPDD,$S(DGPDD=2.312:$P(DFLD,",",2),1:DFLD),0),U)," ****",!
149 Q
150 ;
151NEWPGE() ; Check for device and execute header if user does not quit
152 N DIR,DGOK
153 I IOST?1"C-".E D
154 . S DIR(0)="E" D ^DIR S DGPABRT='+$G(Y)
155 . I 'DGPABRT S DGOK=1
156 Q +$G(DGOK)
Note: See TracBrowser for help on using the repository browser.