source: FOIAVistA/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACSRPT.m@ 1397

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