source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACSRPT.m@ 1800

QACSRPT ;HISC/CEW - Report of Service Contacts ;7/17/95  12:24

 ;;2.0;Patient Representative;**3**;07/25/1995

DATE ;

 W !!,"Select the date range you want to print."

 D ^QAQDATE G:QAQQUIT EXIT I QAQNBEG>DT W !,?5,"*** Beginning date must be today or earlier! ***",*7 G DATE

 K %ZIS,IOP S %ZIS="MQ" W ! D ^%ZIS G:POP EXIT

 I $D(IO("Q")) D  G EXIT

 . S (ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"),ZTSAVE("QAQ2HED"))=""

 . S ZTDESC="Patient Rep Service Report"

 . S ZTRTN="SERTSK^QACSRPT"

 . D ^%ZTLOAD

 . I $G(ZTSK) W !,"Task Number: ",ZTSK

 . Q

SERTSK ;

 K ^TMP($J,"QACSRPT0"),^TMP($J,"QACSRPT1"),^TMP($J,"QACSRPT2")

 S (^TMP($J,"QACSRPT0"),^TMP($J,"QACSRPT1"),^TMP($J,"QACSRPT2"))=0

 U IO

 K QACDT,QACD0,QACCN,QACSIEN,QACCIEN,QACINM,QACHDNM,QACHDIEN

 S QACDT=QAQNBEG-.0000001 F  S QACDT=$O(^QA(745.1,"D",QACDT)) Q:(QACDT'>0)!(QACDT>QAQNEND)!(QACDT\1'?7N)  D

 . S QACD0=0 F  S QACD0=$O(^QA(745.1,"D",QACDT,QACD0)) Q:QACD0'>0  D

 .. S QACCN=0 F  S QACCN=$O(^QA(745.1,QACD0,3,QACCN)) Q:QACCN'>0  D

 ... S QACSN=0 F  S QACSN=$O(^QA(745.1,QACD0,3,QACCN,1,QACSN)) Q:QACSN'>0  D

 .... S QACSIEN=$P($G(^QA(745.1,QACD0,3,QACCN,1,QACSN,0)),U,1) Q:QACSIEN=""

 .... S QACSERV=$$EN4^QACUTIL(QACSIEN)

 .... S QACCIEN=$P($G(^QA(745.1,QACD0,3,QACCN,0)),U,1) Q:QACCIEN=""

 .... S QACICODE=$P($G(^QA(745.2,QACCIEN,0)),U,1) Q:QACICODE=""

 .... I $E(QACICODE,1,2)?2A S QACHD=$E(QACICODE,1,2)

 .... E  S QACHD=$E(QACICODE,1)

 .... S QACHDIEN=0 F  S QACHDIEN=$O(^QA(745.2,"B",QACHD,QACHDIEN)) Q:QACHDIEN'>0  D SET

 .... Q

 ... Q

 .. Q

 . Q

PRINT ;

 ;This is the header information on each page and the data by service.

 K QACUNDL S $P(QACUNDL,"-",81)="",QACQUIT=0,QACPG=1

 I $O(^TMP($J,"QACSRPT0",""))="" S QACSERV="" D HEAD W !!,"No data found for the date range selected!" Q

 K QACSERV,QACHDIEN,QACHD,QACCIEN,QACICODE,QACSTOT,QACCTOT,QACHDTOT

 S QACSERV="" F  S QACSERV=$O(^TMP($J,"QACSRPT0",QACSERV)) Q:(QACSERV="")!(QACQUIT)  D

 . S QACSTOT=$P($G(^TMP($J,"QACSRPT0",QACSERV)),U,1) Q:QACSTOT=""

 . D HEAD

 . W !!?15,"Total Issues for ",QACSERV," = ",QACSTOT

 . S QACHD="" F  S QACHD=$O(^TMP($J,"QACSRPT1",QACSERV,QACHD)) Q:(QACHD="")!(QACQUIT)  D

 .. S QACHDIEN=$P(QACHD,"^",2)

 .. S QACHDNM=$$EN6^QACUTIL(QACHDIEN)

 .. S QACHDTOT=$P($G(^TMP($J,"QACSRPT1",QACSERV,QACHD)),U,1) Q:(QACHDTOT="")!(QACQUIT)

 .. W !!?5,QACHDNM,?75,QACHDTOT

 .. S QACICODE="" F  S QACICODE=$O(^TMP($J,"QACSRPT2",QACSERV,QACHD,QACICODE)) Q:(QACICODE="")!(QACQUIT)  D

 ... S QACCIEN=$P(QACICODE,"^",2)

 ... S QACCNM=$$EN5^QACUTIL(QACCIEN)

 ... S QACCTOT=$P($G(^TMP($J,"QACSRPT2",QACSERV,QACHD,QACICODE)),U,1) Q:(QACCTOT="")!(QACQUIT)

 ... W !,QACCNM,?75,QACCTOT

 ... I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE Q:QACQUIT  D HEAD

 ... Q

 .. Q

 . W ! D PAUSE

 . Q

EXIT ;

 W ! D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

 K IOP,%ZIS,ZTSAVE,ZTDESC,ZTRTN,QACDT,QACD0,QACCN,QACCIEN,QACICODE,ZTSK

 K QACSIEN,QACSERV,QACHEAD,QACHDIEN,QACHDNM,QACINAME,QACQUIT,Y,%DT,QACPG

 K QACDIS,QACHDTOT,QACTOT,QACHDREC,QACREC,DIR,POP,QACCNM,QACSN,QACUNDL

 K ^TMP("J","QACSRPT0"),^TMP($J,"QACSRPT1"),^TMP($J,"QACSRPT2")

 K DIRUT,DIROUT,QACCTOT,QACHD,QACSTOT

 D K^QAQDATE

 Q

HEAD ;

 W:($E(IOST)="C")!(QACPG>1) @IOF

 W !,"Issue Report for ",QACSERV S Y=DT D DD^%DT W ?60,"Date: ",Y,!

 W QAQ2HED,?60,"Page: ",QACPG

 W !,QACUNDL,! S QACPG=QACPG+1

 Q

PAUSE ;

 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S QACQUIT=$S(Y'>0:1,1:0)

 Q

SET ;Counts the records.

 S ^TMP($J,"QACSRPT0",QACSERV)=$G(^TMP($J,"QACSRPT0",QACSERV))+1

 S ^TMP($J,"QACSRPT1",QACSERV,QACHD_"^"_QACHDIEN)=$G(^TMP($J,"QACSRPT1",QACSERV,QACHD_"^"_QACHDIEN))+1

 S ^TMP($J,"QACSRPT2",QACSERV,QACHD_"^"_QACHDIEN,QACICODE_"^"_QACCIEN)=$G(^TMP($J,"QACSRPT2",QACSERV,QACHD_"^"_QACHDIEN,QACICODE_"^"_QACCIEN))+1

 Q