PSOTPCLR ;BIRM/PDW-LETTER PRINT REPORTS ;AUG 8, 2003 ;;7.0;OUTPATIENT PHARMACY;**145,227**;DEC 1997 Q EN ; Q ;placed out of order by patch PSO*7*227 K DIR S DIR(0)="SO^N:Patients/Letters NOT Printed;P:Patients/Letters Printed" D ^DIR I Y="N" S PARAM=Y G DEVICE I Y="P" S PARAM=Y G DEVICE Q DEVICE ; W !,"Queuing is recommended",! K %ZIS S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D K ZTSK G EXIT2 . S ZTRTN="DEQUE^PSOTPCLR",ZTDESC="TPB PRINT LETTER REPORT" . S ZTSAVE("PARAM")="" . D ^%ZTLOAD D ^%ZISC . I $G(ZTSK) W !!,"Tasked with "_ZTSK ; DEQUE ; DEQUE/PRINT LETTERS K ^TMP($J,"PSOTPBLR"),DIVCNT S DIVDA=0 F S DIVDA=$O(^PS(52.91,"AC",DIVDA)) Q:DIVDA'>0 D . S DFN=0 F S DFN=$O(^PS(52.91,"AC",DIVDA,DFN)) Q:DFN'>0 D .. S PRTDTI=$$GET1^DIQ(52.91,DFN,11,"I") I PARAM="P",'PRTDTI Q .. S PRTDTI=$$GET1^DIQ(52.91,DFN,11,"I") I PARAM="N",PRTDTI Q .. S PTNM=$$GET1^DIQ(52.91,DFN,.01),PRTDT=$$FMTE^XLFDT(PRTDTI,"2D") .. S ^TMP($J,"PSOTPBLR",DIVDA,PTNM,DFN)=PRTDT .. S DIVCNT(DIVDA)=$G(DIVCNT(DIVDA))+1 PRINT ; print report U IO K DIVCNT,PSOSTOP S PG=0,LINE="",$P(LINE,"=",79)="" S DIVDA=0 F Q:$G(PSOSTOP) S DIVDA=$O(^TMP($J,"PSOTPBLR",DIVDA)) Q:DIVDA'>0 D . D HEADER . S PTNM="" F Q:$G(PSOSTOP) S PTNM=$O(^TMP($J,"PSOTPBLR",DIVDA,PTNM)) Q:PTNM="" D .. S DFN=0 F Q:$G(PSOSTOP) S DFN=$O(^TMP($J,"PSOTPBLR",DIVDA,PTNM,DFN)) Q:DFN'>0 D ... S DIVCNT(DIVDA)=$G(DIVCNT(DIVDA))+1 ... D PG ... W !,$$GET1^DIQ(52.91,DFN,.01) ... I PARAM="P" W ?35,^TMP($J,"PSOTPBLR",DIVDA,PTNM,DFN) Q ... S INACTDT=$$GET1^DIQ(52.91,DFN,2,"I"),EXCODE=$$GET1^DIQ(52.91,DFN,3),EXREA=$$GET1^DIQ(52.91,DFN,8) ... W:INACTDT ?35,$$FMTE^XLFDT(INACTDT,"2D") W:$L(EXCODE) ?45,EXCODE ... W:$L(EXREA) !,?10,"Exclusion Reason: ",EXREA SUMMARY ; W:'$D(DIVCNT) !!,"No Data Found" Q:$G(PSOSTOP) I PG,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR I 'Y S PSOSTOP=1 Q W !,@IOF,!!,?10,"SUMMARY of TPB LETTER PRINTING " I PARAM="P" W "'PRINTED'" I 1 E W "'NOT PRINTED'" W !! S DIVDA=0 F S DIVDA=$O(DIVCNT(DIVDA)) Q:DIVDA'>0 D . W !,?5,$$GET1^DIQ(52.92,DIVDA,.01),?40,DIVCNT(DIVDA) W:'$D(DIVCNT) !!,"No Data Found" W ! G EXIT ; PG I $Y>(IOSL-4) D HEADER Q HEADER ; W ! I PG,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR I 'Y S PSOSTOP=1 Q W @IOF S PG=PG+1 W ?20,$$GET1^DIQ(52.92,DIVDA,.01) I PARAM="P" W " TPB PATIENTS LETTERS PRINTED REPORT",! I 1 E W " TPB PATIENTS LETTERS NOT PRINTED REPORT",! W ?28,$$FMTE^XLFDT(DT,"1D"),?60,"Page: ",PG,!,LINE I PARAM="N" W !,?35,"Inactivation",!,"Patient",?35,"Date",?45,"Reason",! Q EXIT ; I $E(IOST)="C" W !!,"End of Report",! K DIR S DIR(0)="EO",DIR("A")=" - Continue" D ^DIR K ^TMP($J,"PSOTPBLR") I $G(ZTSK) D KILL^%ZTLOAD EXIT2 D ^%ZISC K DIR,DIVCNT,DIVDA,LINE,PARAM,PG,PRTDT,PRTDTI,PTNM,SRDT Q