113 lines
4.8 KiB
Mathematica
113 lines
4.8 KiB
Mathematica
QANRPT2 ;HISC/GJC-SUMMARY OF INCIDENTS FOR OUTPATIENTS ;5/6/91
|
|
;;2.0;Incident Reporting;**26,29**;08/07/1992
|
|
;
|
|
S PAGE=0
|
|
;D DIV^QANRPT1
|
|
;DON'T FORGET QAQDATE FOR AD HOC REPORTS!
|
|
D ^QAQDATE I QAQQUIT D K^QAQDATE W !!,$C(7),"Invalid date range, no report will be produced." D KILL Q
|
|
S QAQNBEG(0)=QAQNBEG-.00000001,QAQNEND(0)=QAQNEND_".99999999"
|
|
S (PAGE,QANTYPE,QANTINC)=0
|
|
S QANHEAD(0)="QUALITY MANAGEMENT INCIDENT REPORT",QANHEAD(1)="SUMMARY OF INCIDENTS FOR OUTPATIENTS."
|
|
S Y=$P(QAQNBEG,".") D DD^%DT S QANDATE(0)=Y
|
|
S Y=$P(QAQNEND,".") D DD^%DT S QANDATE(1)=Y
|
|
D DIV^QANRPT1
|
|
S QANHEAD(3)="FOR THE PERIOD "_QANDATE(0)_" TO "_QANDATE(1)
|
|
;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)=""
|
|
LOOP ;loop through the date x-ref for records in the date range
|
|
N QANCC,QANDD,QANEE
|
|
S QANEE=QAQNBEG(0)
|
|
F S QANEE=$O(^QA(742.4,"BDT",QANEE)) Q:QANEE'>0!(QANEE>QAQNEND(0)) D
|
|
. S QANCC=0
|
|
. F S QANCC=$O(^QA(742.4,"BDT",QANEE,QANCC)) Q:QANCC'>0 D
|
|
. . S QANDD=0
|
|
. . F S QANDD=$O(^QA(742,"BCS",QANCC,QANDD)) Q:QANDD'>0 D
|
|
. . . Q:$P(^QA(742,QANDD,0),U,5)'=0
|
|
. . . S QANIEN=QANCC Q:QANIEN'>0
|
|
. . . S QANZER0=^QA(742.4,QANIEN,0)
|
|
. . . Q:$P(QANZER0,U,8)=2
|
|
. . . S QANDIV=$P(QANZER0,U,22) I $G(QANDIV)']"" S QANDIV=0
|
|
. . . I $G(QAN1DIV)]"" Q:QAN1DIV'=QANDIV
|
|
. . . I '$D(^QA(740,1,"QAN2","B",QANDIV)) S QANDIV=0
|
|
. . . I $P($G(^QA(740,1,"QAN")),U,5)'=1 S QANDIV=0
|
|
. . . S QANINC=$P(QANZER0,U,2) Q:$G(QANINC)'>0
|
|
. . . S ^TMP("QANRPT2",$J,"QAN",QANDIV,QANINC,QANIEN,QANDD)=""
|
|
I '$D(^TMP("QANRPT2",$J)) W !!,$C(7),"No records found for the selected date range." D KILL Q
|
|
D TOTAL
|
|
TASK S Y=DT X ^DD("DD") S TODAY=Y,$P(BNDRY,"-",$S(IOM=132:133,1:81))="",QANFIN=""
|
|
;*** Choose device ***
|
|
K IOP,%ZIS S %ZIS("A")="Print on device: ",%ZIS="MQ" W ! D ^%ZIS W !!
|
|
G:POP KILL
|
|
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
|
|
STRT U IO ;D HDR^QANAUX1
|
|
D:QANFIN'["^" PRINT ;ORD D:QANFIN'["^" FINAL
|
|
EXIT W ! D ^%ZISC,HOME^%ZIS
|
|
KILL ;Kill and quit.
|
|
D K^QAQDATE
|
|
K %,C,COUNT,D,DIC,BNDRY,LOOP,PAGE
|
|
K QAN,QANCDNT,QANFIN,QANHEAD
|
|
K QANINC0,QANINC1,QANJD,QANDATE,QANNCDT,QANWARD,QANZER0,TODAY,Y,QANTINC
|
|
K QANTYPE,QANINC,QANINCID,QANY,QANCHOS,X
|
|
K DTOUT,DIROUT,DIRUT,DUOUT
|
|
K ^TMP("QANRPT2")
|
|
Q
|
|
FINAL ;Final data summation.
|
|
D:$Y>(IOSL-6) HDR^QANAUX1 Q:QANFIN["^"
|
|
I '$G(COUNT("TOT")) W !!,"No incidents found, exiting the report." G EXIT
|
|
I $G(QANDVFLG)=1 W !!,"Total number if incidents for division "_QANDV_": "_COUNT("DIV",QANAA)
|
|
W !!,"The total number of outpatient incidents is: ",COUNT("TOT")
|
|
D HDH
|
|
Q
|
|
ORD ;
|
|
Q:'$D(QANINC0)
|
|
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),!
|
|
Q
|
|
TOTAL ;
|
|
;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
|
|
N QANAA,QANBB,QANCC,QANDD
|
|
S QANAA=""
|
|
F S QANAA=$O(^TMP("QANRPT2",$J,"QAN",QANAA)) Q:QANAA']"" D
|
|
. S QANBB=0
|
|
. F S QANBB=$O(^TMP("QANRPT2",$J,"QAN",QANAA,QANBB)) Q:QANBB'>0 D
|
|
. . S QANCC=0
|
|
. . F S QANCC=$O(^TMP("QANRPT2",$J,"QAN",QANAA,QANBB,QANCC)) Q:QANCC'>0 D
|
|
. . . S QANDD=0
|
|
. . . F S QANDD=$O(^TMP("QANRPT2",$J,"QAN",QANAA,QANBB,QANCC,QANDD)) Q:QANDD'>0 D
|
|
. . . . S COUNT("INC",QANAA,QANBB)=$G(COUNT("INC",QANAA,QANBB))+1
|
|
. . . . S COUNT("TOT")=$G(COUNT("TOT"))+1
|
|
. . . . S COUNT("DIV",QANAA)=$G(COUNT("DIV",QANAA))+1
|
|
Q
|
|
TOTAL1 ;
|
|
;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']"")
|
|
;S Y=$P(QANZER0,U,2) I Y]"" S C=$P(^DD(742.4,.02,0),U,2) D Y^DIQ S QANNCDT=Y
|
|
;I (+$P(QANZERO,U,5)=0) D TOTAL2
|
|
S (QANDD,QANOUT)=0
|
|
F S QANDD=$O(^QA(742,"BCS",QANCC,QANDD)) Q:QANDD'>0 D
|
|
. I $P(^QA(742,QANDD,0),U,5)'=0 S QANOUT=1
|
|
Q
|
|
TOTAL2 ;
|
|
S QANTINC=QANTINC+1
|
|
I $D(QANINC0(QANNCDT)) S QANINC0(QANNCDT)=QANINC0(QANNCDT)+1
|
|
E S QANINC0(QANNCDT)=1
|
|
Q
|
|
HDH ;
|
|
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QANFIN="^"
|
|
;Q:QANFIN["^" D HDR^QANAUX1
|
|
Q
|
|
QLOOP ;ZTSAVE for TaskMan.
|
|
F BA="^TMP(""QANRPT1"",$J,","^TMP(""QANRPT2"",$J,","BNDRY","PAGE","TODAY","QAN","QAQ*","COUNT(","QANFIN","QANHEAD(","QANCHOS","QANDVFLG" S ZTSAVE(BA)=""
|
|
Q
|
|
PRINT ;print or display data
|
|
I '$D(COUNT) G FINAL
|
|
S QANAA=""
|
|
F S QANAA=$O(^TMP("QANRPT2",$J,"QAN",QANAA)) Q:QANAA']"" D
|
|
. D INST^QANRPT1(QANAA,.QANDV)
|
|
. I $G(QANDVFLG)=1 S QANHEAD(4)="REPORT FOR DIVISION: "_QANDV
|
|
. D HDR^QANAUX1
|
|
. S QANBB=0
|
|
. F S QANBB=$O(^TMP("QANRPT2",$J,"QAN",QANAA,QANBB)) Q:QANBB'>0 D
|
|
. . S QANINCID=$P(^QA(742.1,QANBB,0),U)
|
|
. . D:$Y>(IOSL-6) HDH,HDR^QANAUX1 Q:QANFIN["^"
|
|
. . W !!?17,$E(QANINCID,1,35),?59,COUNT("INC",QANAA,QANBB)
|
|
. D HDH,FINAL
|
|
Q
|