source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANRPT1.m@ 812

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1QANRPT1 ;HISC/GJC-SUMMARY OF INCIDENTS/WARD ;5/6/91
2 ;;2.0;Incident Reporting;**26,29**;08/07/1992
3 ;
4 N QANINFLG,QANLCFLG
5 F W !,"Do you wish to produce a report by Incident Location" S %=1 D YN^DICN Q:"-112"[% W !,$C(7),"Enter ""Y""es to issue a report by Incident Location,",!,"""N""o to issue a report by Patient's Ward."
6 I %=-1 K % Q
7 S:%=2 QANCHOS="W" S:%=1 QANCHOS="I"
8 D DIV
9DATE ;
10 D ^QAQDATE I QAQQUIT W !!,$C(7),"Invalid date range, no report will be produced." D KILL Q
11 S (PAGE,QANTYPE)=0
12 I $D(QAQNBEG) S Y=QAQNBEG D DD^%DT S QANDATE(0)=Y
13 S:$D(QAQNBEG) QAQNBEG=QAQNBEG-.00000001
14 S:$D(QAQNEND) QAQNEND=QAQNEND_".99999999"
15 S QANHEAD(0)="QUALITY MANAGEMENT INCIDENT REPORT",QANHEAD(1)="SUMMARY OF INCIDENTS BY INCIDENT LOCATION",QANHEAD(2)="SUMMARY OF INCIDENTS BY PATIENT WARD"
16 S Y=$P(QAQNEND,".") D DD^%DT S QANDATE(1)=Y
17 S QANHEAD(3)="FOR THE PERIOD "_QANDATE(0)_" TO "_QANDATE(1)
18 D INCD^QANUTL4 I QANY D KILL Q
19 D:QANCHOS="I" QANLOC^QANUTL4 D:QANCHOS="W" WARD^QANUTL4 I QANY D KILL Q
20LOOP ;
21 N QANCC,QANEE
22 S QANEE=QAQNBEG
23 F S QANEE=$O(^QA(742.4,"BDT",QANEE)) Q:QANEE'>0!(QANEE>QAQNEND) D
24 . S QANCC=0
25 . F S QANCC=$O(^QA(742.4,"BDT",QANEE,QANCC)) Q:QANCC'>0 D
26 . . S QANDD=0
27 . . F S QANDD=$O(^QA(742,"BCS",QANCC,QANDD)) Q:QANDD'>0 D
28 . . . S QAN7424=^QA(742.4,QANCC,0) Q:$G(QAN7424)']""
29 . . . S QAN742=^QA(742,QANDD,0) Q:$G(QAN742)']""
30 . . . I $P(QAN7424,U,8)=2 Q
31 . . . S QANINC=$P(QAN7424,U,2) I $G(QANINC)']"" Q
32 . . . I $G(QANINFLG)'=1 I $G(^TMP("QANRPT1",$J,"INC",QANINC))']"" Q
33 . . . I $P(QAN742,U,5)'=1 Q
34 . . . S QANLCN=$S($G(QANCHOS)="I":$P(QAN7424,U,4),1:$P(QAN742,U,6)) Q:'$G(QANLCN)
35 . . . I $G(QANCHOS)="I" S QANLOC=$P(^QA(742.5,QANLCN,0),U)
36 . . . I $G(QANCHOS)="W" S QANLOC=$P(^SC($P(QAN742,U,6),0),U)
37 . . . I $G(QANLOC)']"" Q
38 . . . I $G(QANLCFLG)'=1 I $G(^TMP("QANRPT1",$J,"LOC",QANLCN))']"" Q
39 . . . S QANDIV=$P(QAN7424,U,22) I $G(QANDIV)']"" S QANDIV=0
40 . . . I $G(QAN1DIV)]"" Q:QAN1DIV'=QANDIV
41 . . . I '$D(^QA(740,1,"QAN2","B",QANDIV)) S QANDIV=0
42 . . . I $P($G(^QA(740,1,"QAN")),U,5)'=1 S QANDIV=0
43 . . . S QANINC=$P(^QA(742.1,QANINC,0),U)
44 . . . S QANINC=$TR(QANINC,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
45 . . . S ^TMP("QANRPT1",$J,"QAN",QANDIV,QANLOC,QANINC,QANCC,QANDD)=""
46 I '$D(^TMP("QANRPT1",$J)) W !!,$C(7),"No records found for the selected date range." D KILL Q
47 S QANWORD=$S($G(QANCHOS)="I":"Incident",1:"Ward")
48 I '$G(QANLCFLG),('$D(^TMP("QANRPT1",$J,"LOC"))) W !!,$C(7),QANWORD," location(s) not found, exiting the report." D KILL Q
49 I '$G(QANINFLG),('$D(^TMP("QANRPT1",$J,"INC"))) W !!,$C(7),"Incident(s) not found, exiting the report." D KILL Q
50 D TOTAL
51TASK S Y=DT X ^DD("DD") S TODAY=Y,$P(BNDRY,"-",$S(IOM=132:133,1:81))="",QANFIN=""
52 ;*** Choose device ***
53 K IOP,%ZIS S %ZIS("A")="Print on device: ",%ZIS="MQ" W ! D ^%ZIS W !!
54 G:POP KILL
55 I $D(IO("Q")) S ZTRTN="STRT^QANRPT1",ZTDESC="Generate Incident reports for incidents by type." D QLOOP^QANRPT2,^%ZTLOAD W !,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),! G EXIT
56STRT U IO
57 D:QANFIN'["^" PRINT
58EXIT W ! D ^%ZISC,HOME^%ZIS
59KILL ;Kill and quit.
60 D K^QAQDATE
61 K QAQNBEG,QAQNEND
62 K QAN742,QAN7424,QANAA,QANBB,QANCC,QANDD,QANEE,QANFF,QANXX,QANYY,QANZZ
63 K BNDRY,COUNT,LOOP,PAGE,TODAY,X,Y,%
64 K QANCDNT,QANCHOS,QANCNT,QANDAT1,QANDAT2,QANDATA1,QANDATA2,QANDATE
65 K QANDIV,QANDV,QANDVFLG,QANDVN,QANDVSN,QANFLG,QANFIN,QANINC,QANINFLG
66 K QANHEAD,QANINC,QANINCID,QAN,QANLCFLG,QANLOC,QANLOCA
67 K QANNODE,QANNUM,QANTYPE,QANY
68 K ^TMP("QANRPT1"),LP,LP0,LP1,LP2,QA,C
69 K DIROUT,DIRUT,DTOUT,DUOUT,D
70 Q
71FINAL ;Final data summation.
72 D:$Y>(IOSL-4) HDH,HDR^QANAUX1 Q:QANFIN["^"
73 I $G(COUNT("TOT"))'>0 W !!,"No incidents found, exiting the report." Q
74 S QANFF=""
75 F S QANFF=$O(COUNT("LOC",QANAA,QANFF)) Q:QANFF']"" D
76 . S QANLOCA=QANFF
77 . W !,"Total number of incidents for "_$S(QANCHOS="W":"ward ",1:"incident location ")_QANLOCA_": "_COUNT("LOC",QANAA,QANFF)
78 I $G(QANDVFLG)=1 W !!,"Total number of Incidents for division "_QANDV_": "_COUNT("DIV",QANAA)
79 W !!,"Total number of incidents this reporting period: "_COUNT("TOT")
80 D HDH
81 Q
82TOTAL ;
83 N QANAA,QANBB,QANCC,QANDD
84 S QANAA=""
85 F S QANAA=$O(^TMP("QANRPT1",$J,"QAN",QANAA)) Q:QANAA']"" D
86 . S QANBB=""
87 . F S QANBB=$O(^TMP("QANRPT1",$J,"QAN",QANAA,QANBB)) Q:QANBB']"" D
88 . . S QANCC=""
89 . . F S QANCC=$O(^TMP("QANRPT1",$J,"QAN",QANAA,QANBB,QANCC)) Q:QANCC']"" D
90 . . . S QANDD=0
91 . . . F S QANDD=$O(^TMP("QANRPT1",$J,"QAN",QANAA,QANBB,QANCC,QANDD)) Q:QANDD'>0 D
92 . . . . S COUNT("INC",QANAA,QANBB,QANCC)=$G(COUNT("INC",QANAA,QANBB,QANCC))+1
93 . . . . S COUNT("TOT")=$G(COUNT("TOT"))+1
94 . . . . S COUNT("DIV",QANAA)=$G(COUNT("DIV",QANAA))+1
95 . . . . S COUNT("LOC",QANAA,QANBB)=$G(COUNT("LOC",QANAA,QANBB))+1
96 Q
97HDH ;
98 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QANFIN="^"
99 Q
100WARD ;
101 N QANCNT,QANDD
102 S QANDD=0
103 S QANCNT=1
104 F S QANDD=$O(^QA(742,"BCS",QANIEN,QANDD)) Q:QANDD'>0 D
105 . Q:'$P($G(^QA(742,QANDD,0)),U,6)
106 . S QANLOC(QANCNT)=$P(^QA(742,QANDD,0),U,6)
107 . S QANCNT=QANCNT+1
108 Q
109INST(QANIEN,QANDV) ;api for getting division name
110 N DIC
111 K QANDV
112 S DIC="^DIC(4,"
113 S DIC(0)="NZX"
114 S DIC("S")="I $D(^QA(740,1,""QAN2"",""B"",X))"
115 S X=QANIEN
116 D ^DIC K DIC
117 I Y<0 S QANDV="Unknown" Q
118 S QANDV=Y(0,0)
119 Q
120PRINT ;print or display data
121 I '$D(COUNT) G FINAL
122 S QANAA=""
123 F S QANAA=$O(COUNT("INC",QANAA)) Q:QANAA']"" D
124 . D INST(QANAA,.QANDV)
125 . I $G(QANDVFLG)=1 S QANHEAD(4)="REPORT FOR DIVISION: "_QANDV
126 . D HDR^QANAUX1
127 . S QANBB=""
128 . F S QANBB=$O(COUNT("INC",QANAA,QANBB)) Q:QANBB']"" D
129 . . D:$Y>(IOSL-6) HDH,HDR^QANAUX1 Q:QANFIN["^" W !!,$E(QANBB,1,32)
130 . . S QANCC=""
131 . . F S QANCC=$O(COUNT("INC",QANAA,QANBB,QANCC)) Q:QANCC']"" D
132 . . . S QANDD=$O(^TMP("QANRPT1",$J,"QAN",QANAA,QANBB,QANCC,0)) Q:QANDD'>0
133 . . . S QANINCID=$P(^QA(742.1,$P(^QA(742.4,QANDD,0),U,2),0),U)
134 . . . S QANNUM=COUNT("INC",QANAA,QANBB,QANCC)
135 . . . D:$Y>(IOSL-4) HDH,HDR^QANAUX1 W ?35,$E(QANINCID,1,35),?72,QANNUM,!
136 . D FINAL
137 Q
138DIV ;
139 K QANDVFLG,QAN1DIV
140 S QANDVFLG=$P($G(^QA(740,1,"QAN")),U,5)
141 Q:$G(QANDVFLG)'=1
142 N DIR,DIRUT,DTOUT,DUOUT
143 S DIR(0)="YA"
144 S DIR("A")="Select ALL Divisions? "
145 S DIR("B")="YES"
146 D ^DIR K DIR I $D(DIRUT) S QANPOP=1 Q
147 I Y S QAN1DIV="" Q
148 N DIC
149 S DIC="^QA(740,1,""QAN2"","
150 S DIC(0)="AEMZQ"
151 S DIC("A")="Enter Division: "
152 S QANDVSN=$O(^QA(740,1,"QAN2",0)) Q:$G(QANDVSN)'>0
153 D INST($G(^QA(740,1,"QAN2",QANDVSN,0)),.QANDVN)
154 S DIC("B")=$G(QANDVN)
155 D ^DIC K DIC
156 I +Y>0 S QAN1DIV=Y(0)
157 Q
Note: See TracBrowser for help on using the repository browser.