76 lines
2.7 KiB
Mathematica
76 lines
2.7 KiB
Mathematica
|
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
|