source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCIRP1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1DVBCIRP1 ;ALB/GTS-AMIE INSUFFICIENT 2507 RPT -CONT 1 ; 11/10/94 1:30 PM
2 ;;2.7;AMIE;**13,19,27**;Apr 10, 1995
3 ;
4 ;** Version Changes
5 ; 2.7 - New routine (Enhc 15)
6 ;
7SUMRPT ;**Output the summary report
8 W:IOST?1"C-".E @IOF
9 D SUMHD
10 ;print request data
11 W !?3,"Total 2507 requests received for date range:",?71,$J(DVBARQCT,5)
12 W !?3,"Total insufficient 2507 requests received for date range:",?71,$J(DVBAINRQ,5)
13 W !?3,"Total insufficient 2507 requests cancelled by RO for date range:",?71,$J(DVBACAN("REQ"),5)
14 I DVBARQCT>0 D
15 .S PERCENT=(DVBAINRQ/DVBARQCT)*100
16 .W !?3,"% of insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
17 .S PERCENT=((DVBAINRQ-DVBACAN("REQ"))/DVBARQCT)*100
18 .W !?3,"% of uncancelled insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
19 I DVBARQCT'>0 D
20 .S PERCENT=0
21 .W !?3,"% of insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
22 .W !?3,"% of uncancelled insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
23 ;print exam data
24 W !!?3,"Total 2507 exams received for date range:",?71,$J(DVBAXMCT,5)
25 W !?3,"Total insufficient 2507 exams received for date range:",?71,$J(DVBAINXM,5)
26 W !?3,"Total insufficient 2507 exams cancelled by RO for date range:",?71,$J(DVBACAN("EXM"),5)
27 I DVBAXMCT>0 D
28 .S PERCENT=(DVBAINXM/DVBAXMCT)*100
29 .W !?3,"% of insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
30 .S PERCENT=((DVBAINXM-DVBACAN("EXM"))/DVBAXMCT)*100
31 .W !?3,"% of uncancelled insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
32 I DVBAXMCT'>0 D
33 .S PERCENT=0
34 .W !?3,"% of insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
35 .W !?3,"% of uncancelled insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
36 ;print insufficient reason data
37 I IOST?1"C-".E DO
38 .K DTOUT,DUOUT
39 .W !!
40 .D PAUSE^DVBCUTL4
41 .I '$D(DTOUT),('$D(DUOUT)) DO
42 ..W @IOF
43 ..D SUMHD
44 I '$D(DTOUT),('$D(DUOUT)) DO
45 .W:IOST'?1"C-".E !!
46 .W !?15,"Summary of insufficient exams per Reason",!
47 .W !?3,"Reason",?53,"Num",?59,"Percent"
48 .N DVBARSLP S DVBARSLP=""
49 .F S DVBARSLP=$O(DVBAINXM(DVBARSLP)) Q:DVBARSLP="" DO ;**Reason tot's
50 ..W:+DVBARSLP>0 !?3,$P(^DVB(396.94,DVBARSLP,0),U,3),?53,DVBAINXM(DVBARSLP)
51 ..I +DVBARSLP'>0,(+DVBAINXM(DVBARSLP)>0) W !?3,"Exams without insufficient reason indicated",?53,DVBAINXM(DVBARSLP)
52 ..W:(+DVBAINXM(DVBARSLP)>0&(DVBAINXM>0)) ?59,($P(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",1))_$S($E($P(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1)'="":"."_$E($P(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1),1:"")_" %"
53 .I IOST?1"C-".E DO
54 ..D CONTMES^DVBCUTL4
55 Q
56 ;
57SUMHD ;** Output Summary Report heading
58 N STRTDT,LSTDT
59 W !?15,"Summary Insufficient Exam Report for ",$$SITE^DVBCUTL4(),!
60 S Y=$P(BEGDT,".",1) X ^DD("DD") S STRTDT=Y K Y
61 S Y=$P(ENDDT,".",1) X ^DD("DD") S LSTDT=Y K Y
62 W !?16,"For Date Range: "_STRTDT_" to "_LSTDT,!
63 Q
64 ;
65DETAIL ;** Output reason, exam type and exam info
66 N STRTDT,LSTDT
67 S Y=$P(BEGDT,".",1) X ^DD("DD") S STRTDT=Y K Y
68 S Y=$P(ENDDT,".",1) X ^DD("DD") S LSTDT=Y K Y
69 U IO
70 S DVBADTLP=BEGDT
71 S DVBAENDL=ENDDT
72 D DETHD^DVBCIUTL
73 S RSDA=""
74 S DVBAPG1=""
75 F S RSDA=$O(DVBAARY("REASON",RSDA)) Q:(RSDA=""!($D(GETOUT))) DO
76 .K DVBARSPT
77 .S TPDA=""
78 .F S TPDA=$O(^TMP($J,"XMTYPE",TPDA)) Q:(TPDA=""!($D(GETOUT))) DO
79 ..K DVBAXMPT
80 ..S XMDA=""
81 ..F S XMDA=$O(^DVB(396.4,"AIT",RSDA,TPDA,XMDA)) Q:(XMDA=""!($D(GETOUT))) DO
82 ...I $P(^DVB(396.3,$P(^DVB(396.4,XMDA,0),U,2),0),U,5)>DVBADTLP,($P(^DVB(396.3,$P(^DVB(396.4,XMDA,0),U,2),0),U,5)<DVBAENDL) D EXMOUT^DVBCIUTL
83 I '$D(GETOUT),(IOST?1"C-".E) D CONTMES^DVBCUTL4
84 D ^%ZISC
85 D KVARS ;**KILL the variables used by DETAIL
86 Q
87 ;
88KVARS ;** Final Kill for Detail report
89 S:$D(ZTQUEUED) ZTREQ="@"
90 K ^TMP($J),DVBAARY,DVBANAME,DVBASSN,DVBACNUM,RSDA,TPDA,XMDA,DVBADTLP
91 K DVBAENDL,DVBARSPT,DVBAXMPT,REQDA,DFN,DVBAORXM,DVBAXMTP,DVBACMND
92 K DVBAORPV,DVBAORP1,DVBADTWK,DVBADTE,DVBAORDT,DVBANAM1,GETOUT
93 K DVBAARY,DVBAPG1,DVBARQDT,DVBAXDT,DVBAXRS
94 Q
95 ;
96DETSEL ;** Select the details to report
97 D RSEL^DVBCIUTL
98 I '$D(DVBAARY("REASON")) S DVBAQTSL=""
99 I $D(DVBAQTSL) DO
100 .S DIR("A",1)="You have not selected Insufficient reasons to report."
101 .S DIR("A",2)="This is required to print the Detailed report."
102 .S DIR("A",3)=" "
103 .S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
104 I '$D(DVBAQTSL) DO
105 .D XMSEL^DVBCIUTL
106 .I '$D(^TMP($J,"XMTYPE")) S DVBAQTSL=""
107 .I $D(DVBAQTSL) DO
108 ..S DIR("A",1)="You have not selected Exams to report."
109 ..S DIR("A",2)="This is required to print the Detailed report."
110 ..S DIR("A",3)=" "
111 ..S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
112 ..K DVBAARY("REASON")
113 Q
114 ;
Note: See TracBrowser for help on using the repository browser.