source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCIRPT.m@ 841

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1DVBCIRPT ;ALB/GTS-AMIE C&P INSUFF EXAM TRACKING RPT ; 11/9/94 2:00 PM
2 ;;2.7;AMIE;**13,19,27**;Apr 10, 1995
3 ;
4 ;** Version Changes
5 ; 2.7 - New routine (Enhc 15)
6 ;
7MAIN ;**Select Dte Rng & Rpt Type; call report routine
8 F Q:$D(DVBAOUT) DO
9 .D HOME^%ZIS
10 .S TVAR(1,0)="0,0,1,2:2,1^Insufficient 2507 Exam Report"
11 .D WR^DVBAUTL4("TVAR")
12 .K TVAR
13 .S RPTTYPE=$$RPTTYPE^DVBCUTA1()
14 .S:((RPTTYPE'="D")&(RPTTYPE'="S")) DVBAOUT=""
15 .W:'$D(DVBAOUT) !!
16 .D:'$D(DVBAOUT) DATE^DVBCUTL4(.BEGDT,.ENDDT)
17 .I $D(ENDDT),(+ENDDT>0) DO
18 ..S ENDDT=ENDDT_".2359"
19 ..I RPTTYPE="S" DO
20 ...D DEVSEL
21 ...I POP D SUMKILL
22 ...I 'POP DO
23 ....I $D(IO("Q")) DO
24 .....N DVBAI
25 .....S ZTRTN="SUM^DVBCIRPT",ZTIO=ION
26 .....S ZTDESC="Summary Insufficient Exam Report"
27 .....F DVBAI="BEGDT","ENDDT" S ZTSAVE(DVBAI)=""
28 .....D ^%ZTLOAD
29 .....N TSK S TSK=$S($D(ZTSK)=0:"C",1:"Y")
30 .....I TSK="Y" W !!,"Summary Report Queued. Task number: ",ZTSK
31 .....K ZTSK D CONTMES^DVBCUTL4
32 .....D SUMKILL
33 ....I '$D(IO("Q")) D SUM
34 ...D ^%ZISC
35 ..I RPTTYPE="D" DO
36 ...D DETSEL^DVBCIRP1 ;**Select the Reasons and Exams to report
37 ...I '$D(DVBAQTSL) DO
38 ....D DEVSEL
39 ....I POP D KVARS^DVBCIRP1
40 ....I 'POP DO
41 .....I $D(IO("Q")) DO
42 ......N DVBAI
43 ......S ZTRTN="DETAIL^DVBCIRP1",ZTIO=ION
44 ......S ZTDESC="Detailed Insufficient Exam Report"
45 ......F DVBAI="BEGDT","ENDDT","DVBAARY(""REASON"",","^TMP($J,""XMTYPE""," S ZTSAVE(DVBAI)=""
46 ......D ^%ZTLOAD
47 ......N TSK S TSK=$S($D(ZTSK)=0:"C",1:"Y")
48 ......I TSK="Y" W !!,"Detail Report Queued. Task number: ",ZTSK
49 ......K ZTSK D CONTMES^DVBCUTL4
50 ......D KVARS^DVBCIRP1
51 .....I '$D(IO("Q")) W:IOST?1"C-".E @IOF D DETAIL^DVBCIRP1
52 ....D ^%ZISC
53 ...K DVBAQTSL
54 ..D CLEANUP
55 D KVARS
56 Q
57 ;
58KVARS ;** Kill the variables used in report
59 K DVBAOUT,ENDDT,BEGDT,DTOUT,DUOUT,RPTTYPE,DVBACAN,DVBASTAT
60 D CLEANUP
61 Q
62 ;
63CLEANUP ;** Kill the variables used by the device handler
64 K %ZIS,POP,%IS,IOP
65 K IOBS,IOHG,IOPAR,IOUPAR,IOXY,POP,%DT,%YY,%XX,ION,IOPAR
66 Q
67 ;
68DEVSEL ;** Select the device to report to
69 S %ZIS="AEQ"
70 S %ZIS("A")="Output device: "
71 D ^%ZIS
72 Q
73 ;
74SUM ;** Set up reason counter array, count all 2507's received
75 U IO
76 S (DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM)=0
77 S DVBACAN("REQ")=0,DVBACAN("EXM")=0
78 S DVBAENDL=ENDDT
79 ;
80 ;** Initialize reason counter array
81 F DVBARIFN=0:0 S DVBARIFN=$O(^DVB(396.94,DVBARIFN)) Q:+DVBARIFN'>0 DO
82 .S DVBAINXM(DVBARIFN)=0
83 S DVBAINXM("NO REASON")=0
84 ;
85 ;** Count the total and insufficient number of exams and 2507 requests
86 S DVBADTLP=BEGDT-.0001
87 F S DVBADTLP=$O(^DVB(396.3,"ADP",DVBADTLP)) Q:(DVBADTLP=""!(DVBADTLP>ENDDT)) DO
88 .S DVBAPRIO=""
89 .F S DVBAPRIO=$O(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO)) Q:DVBAPRIO="" DO
90 ..S DVBADALP=""
91 ..F S DVBADALP=$O(^DVB(396.3,"ADP",DVBADTLP,DVBAPRIO,DVBADALP)) Q:DVBADALP="" DO
92 ...S DVBARQCT=DVBARQCT+1
93 ...K DVBAINSF
94 ...I DVBAPRIO="E" DO
95 ....S DVBAINRQ=DVBAINRQ+1
96 ....I $P(^DVB(396.3,DVBADALP,0),U,18)="RX" S DVBACAN("REQ")=DVBACAN("REQ")+1
97 ....S DVBAINSF=""
98 ...S DVBAXMDA=""
99 ...F S DVBAXMDA=$O(^DVB(396.4,"C",DVBADALP,DVBAXMDA)) Q:DVBAXMDA="" DO
100 ....S DVBAXMCT=DVBAXMCT+1
101 ....I $D(DVBAINSF) DO
102 .....S DVBAINXM=DVBAINXM+1
103 .....S DVBARIFN=$P(^DVB(396.4,DVBAXMDA,0),U,11),DVBASTAT=$P(^(0),U,4)
104 .....S:DVBARIFN="" DVBARIFN="NO REASON"
105 .....S DVBAINXM(DVBARIFN)=DVBAINXM(DVBARIFN)+1
106 .....I DVBASTAT="RX" S DVBACAN("EXM")=DVBACAN("EXM")+1
107 D SUMRPT^DVBCIRP1
108 S:$D(ZTQUEUED) ZTREQ="@"
109 D SUMKILL
110 D ^%ZISC
111 Q
112 ;
113SUMKILL ;** Kill the variables used in the summary report
114 K DVBADTLP,DVBAENDL,DVBARQCT,DVBAINRQ,DVBAXMCT,DVBAINXM
115 K DVBAPRIO,DVBADALP,DVBAXMDA,DVBAINSF,DVBARIFN
116 Q
Note: See TracBrowser for help on using the repository browser.