source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOTPCLR.m@ 636

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")="<cr> - 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