source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANRPT2.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.8 KB
Line 
1QANRPT2 ;HISC/GJC-SUMMARY OF INCIDENTS FOR OUTPATIENTS ;5/6/91
2 ;;2.0;Incident Reporting;**26,29**;08/07/1992
3 ;
4 S PAGE=0
5 ;D DIV^QANRPT1
6 ;DON'T FORGET QAQDATE FOR AD HOC REPORTS!
7 D ^QAQDATE I QAQQUIT D K^QAQDATE W !!,$C(7),"Invalid date range, no report will be produced." D KILL Q
8 S QAQNBEG(0)=QAQNBEG-.00000001,QAQNEND(0)=QAQNEND_".99999999"
9 S (PAGE,QANTYPE,QANTINC)=0
10 S QANHEAD(0)="QUALITY MANAGEMENT INCIDENT REPORT",QANHEAD(1)="SUMMARY OF INCIDENTS FOR OUTPATIENTS."
11 S Y=$P(QAQNBEG,".") D DD^%DT S QANDATE(0)=Y
12 S Y=$P(QAQNEND,".") D DD^%DT S QANDATE(1)=Y
13 D DIV^QANRPT1
14 S QANHEAD(3)="FOR THE PERIOD "_QANDATE(0)_" TO "_QANDATE(1)
15 ;F QAN=0:0 S QAN=$O(^QA(742.4,QAN)) Q:QAN'>0 S QANZER0=$G(^QA(742.4,QAN,0)) I QANZER0]"",($P(QANZER0,U,8)'=2) S QANDATE=$P(QANZER0,U,3) I QANDATE'<QAQNBEG(0),(QANDATE'>QAQNEND(0)) S ^UTILITY($J,"QAN DATE",QAN)=""
16LOOP ;loop through the date x-ref for records in the date range
17 N QANCC,QANDD,QANEE
18 S QANEE=QAQNBEG(0)
19 F S QANEE=$O(^QA(742.4,"BDT",QANEE)) Q:QANEE'>0!(QANEE>QAQNEND(0)) D
20 . S QANCC=0
21 . F S QANCC=$O(^QA(742.4,"BDT",QANEE,QANCC)) Q:QANCC'>0 D
22 . . S QANDD=0
23 . . F S QANDD=$O(^QA(742,"BCS",QANCC,QANDD)) Q:QANDD'>0 D
24 . . . Q:$P(^QA(742,QANDD,0),U,5)'=0
25 . . . S QANIEN=QANCC Q:QANIEN'>0
26 . . . S QANZER0=^QA(742.4,QANIEN,0)
27 . . . Q:$P(QANZER0,U,8)=2
28 . . . S QANDIV=$P(QANZER0,U,22) I $G(QANDIV)']"" S QANDIV=0
29 . . . I $G(QAN1DIV)]"" Q:QAN1DIV'=QANDIV
30 . . . I '$D(^QA(740,1,"QAN2","B",QANDIV)) S QANDIV=0
31 . . . I $P($G(^QA(740,1,"QAN")),U,5)'=1 S QANDIV=0
32 . . . S QANINC=$P(QANZER0,U,2) Q:$G(QANINC)'>0
33 . . . S ^TMP("QANRPT2",$J,"QAN",QANDIV,QANINC,QANIEN,QANDD)=""
34 I '$D(^TMP("QANRPT2",$J)) W !!,$C(7),"No records found for the selected date range." D KILL Q
35 D TOTAL
36TASK S Y=DT X ^DD("DD") S TODAY=Y,$P(BNDRY,"-",$S(IOM=132:133,1:81))="",QANFIN=""
37 ;*** Choose device ***
38 K IOP,%ZIS S %ZIS("A")="Print on device: ",%ZIS="MQ" W ! D ^%ZIS W !!
39 G:POP KILL
40 I $D(IO("Q")) S ZTRTN="STRT^QANRPT2",ZTDESC="Generate Incident reports for incidents by type." D QLOOP,^%ZTLOAD W !,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),! G EXIT
41STRT U IO ;D HDR^QANAUX1
42 D:QANFIN'["^" PRINT ;ORD D:QANFIN'["^" FINAL
43EXIT W ! D ^%ZISC,HOME^%ZIS
44KILL ;Kill and quit.
45 D K^QAQDATE
46 K %,C,COUNT,D,DIC,BNDRY,LOOP,PAGE
47 K QAN,QANCDNT,QANFIN,QANHEAD
48 K QANINC0,QANINC1,QANJD,QANDATE,QANNCDT,QANWARD,QANZER0,TODAY,Y,QANTINC
49 K QANTYPE,QANINC,QANINCID,QANY,QANCHOS,X
50 K DTOUT,DIROUT,DIRUT,DUOUT
51 K ^TMP("QANRPT2")
52 Q
53FINAL ;Final data summation.
54 D:$Y>(IOSL-6) HDR^QANAUX1 Q:QANFIN["^"
55 I '$G(COUNT("TOT")) W !!,"No incidents found, exiting the report." G EXIT
56 I $G(QANDVFLG)=1 W !!,"Total number if incidents for division "_QANDV_": "_COUNT("DIV",QANAA)
57 W !!,"The total number of outpatient incidents is: ",COUNT("TOT")
58 D HDH
59 Q
60ORD ;
61 Q:'$D(QANINC0)
62 S (QANSUB,QANSUB(0))="" F S QANSUB=$O(QANINC0(QANSUB)) Q:QANSUB=""!(QANFIN["^") D:$Y>(IOSL-4) HDH Q:QANFIN["^" W !?17,QANSUB,?59,QANINC0(QANSUB),!
63 Q
64TOTAL ;
65 ;F QAN=0:0 S QAN=$O(^UTILITY($J,"QAN DATE",QAN)) Q:QAN'>0 F QAN(0)=0:0 S QAN(0)=$O(^QA(742,"BCS",QAN,QAN(0))) Q:QAN(0)'>0 D TOTAL1
66 N QANAA,QANBB,QANCC,QANDD
67 S QANAA=""
68 F S QANAA=$O(^TMP("QANRPT2",$J,"QAN",QANAA)) Q:QANAA']"" D
69 . S QANBB=0
70 . F S QANBB=$O(^TMP("QANRPT2",$J,"QAN",QANAA,QANBB)) Q:QANBB'>0 D
71 . . S QANCC=0
72 . . F S QANCC=$O(^TMP("QANRPT2",$J,"QAN",QANAA,QANBB,QANCC)) Q:QANCC'>0 D
73 . . . S QANDD=0
74 . . . F S QANDD=$O(^TMP("QANRPT2",$J,"QAN",QANAA,QANBB,QANCC,QANDD)) Q:QANDD'>0 D
75 . . . . S COUNT("INC",QANAA,QANBB)=$G(COUNT("INC",QANAA,QANBB))+1
76 . . . . S COUNT("TOT")=$G(COUNT("TOT"))+1
77 . . . . S COUNT("DIV",QANAA)=$G(COUNT("DIV",QANAA))+1
78 Q
79TOTAL1 ;
80 ;S QANZER0=$S($D(^QA(742.4,QAN,0))#2:^(0),1:""),QANZERO=$S($D(^QA(742,QAN(0),0))#2:^(0),1:"") Q:QANZER0']""!(QANZERO']"")
81 ;S Y=$P(QANZER0,U,2) I Y]"" S C=$P(^DD(742.4,.02,0),U,2) D Y^DIQ S QANNCDT=Y
82 ;I (+$P(QANZERO,U,5)=0) D TOTAL2
83 S (QANDD,QANOUT)=0
84 F S QANDD=$O(^QA(742,"BCS",QANCC,QANDD)) Q:QANDD'>0 D
85 . I $P(^QA(742,QANDD,0),U,5)'=0 S QANOUT=1
86 Q
87TOTAL2 ;
88 S QANTINC=QANTINC+1
89 I $D(QANINC0(QANNCDT)) S QANINC0(QANNCDT)=QANINC0(QANNCDT)+1
90 E S QANINC0(QANNCDT)=1
91 Q
92HDH ;
93 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QANFIN="^"
94 ;Q:QANFIN["^" D HDR^QANAUX1
95 Q
96QLOOP ;ZTSAVE for TaskMan.
97 F BA="^TMP(""QANRPT1"",$J,","^TMP(""QANRPT2"",$J,","BNDRY","PAGE","TODAY","QAN","QAQ*","COUNT(","QANFIN","QANHEAD(","QANCHOS","QANDVFLG" S ZTSAVE(BA)=""
98 Q
99PRINT ;print or display data
100 I '$D(COUNT) G FINAL
101 S QANAA=""
102 F S QANAA=$O(^TMP("QANRPT2",$J,"QAN",QANAA)) Q:QANAA']"" D
103 . D INST^QANRPT1(QANAA,.QANDV)
104 . I $G(QANDVFLG)=1 S QANHEAD(4)="REPORT FOR DIVISION: "_QANDV
105 . D HDR^QANAUX1
106 . S QANBB=0
107 . F S QANBB=$O(^TMP("QANRPT2",$J,"QAN",QANAA,QANBB)) Q:QANBB'>0 D
108 . . S QANINCID=$P(^QA(742.1,QANBB,0),U)
109 . . D:$Y>(IOSL-6) HDH,HDR^QANAUX1 Q:QANFIN["^"
110 . . W !!?17,$E(QANINCID,1,35),?59,COUNT("INC",QANAA,QANBB)
111 . D HDH,FINAL
112 Q
Note: See TracBrowser for help on using the repository browser.