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