| [613] | 1 | PSOTPCLR ;BIRM/PDW-LETTER PRINT REPORTS ;AUG 8, 2003
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**145,227**;DEC 1997
|
|---|
| 3 | Q
|
|---|
| 4 | EN ;
|
|---|
| 5 | Q ;placed out of order by patch PSO*7*227
|
|---|
| 6 | K DIR S DIR(0)="SO^N:Patients/Letters NOT Printed;P:Patients/Letters Printed" D ^DIR
|
|---|
| 7 | I Y="N" S PARAM=Y G DEVICE
|
|---|
| 8 | I Y="P" S PARAM=Y G DEVICE
|
|---|
| 9 | Q
|
|---|
| 10 | DEVICE ;
|
|---|
| 11 | W !,"Queuing is recommended",!
|
|---|
| 12 | K %ZIS S %ZIS="Q" D ^%ZIS
|
|---|
| 13 | Q:POP
|
|---|
| 14 | I $D(IO("Q")) D K ZTSK G EXIT2
|
|---|
| 15 | . S ZTRTN="DEQUE^PSOTPCLR",ZTDESC="TPB PRINT LETTER REPORT"
|
|---|
| 16 | . S ZTSAVE("PARAM")=""
|
|---|
| 17 | . D ^%ZTLOAD D ^%ZISC
|
|---|
| 18 | . I $G(ZTSK) W !!,"Tasked with "_ZTSK
|
|---|
| 19 | ;
|
|---|
| 20 | DEQUE ; DEQUE/PRINT LETTERS
|
|---|
| 21 | K ^TMP($J,"PSOTPBLR"),DIVCNT
|
|---|
| 22 | S DIVDA=0 F S DIVDA=$O(^PS(52.91,"AC",DIVDA)) Q:DIVDA'>0 D
|
|---|
| 23 | . S DFN=0 F S DFN=$O(^PS(52.91,"AC",DIVDA,DFN)) Q:DFN'>0 D
|
|---|
| 24 | .. S PRTDTI=$$GET1^DIQ(52.91,DFN,11,"I") I PARAM="P",'PRTDTI Q
|
|---|
| 25 | .. S PRTDTI=$$GET1^DIQ(52.91,DFN,11,"I") I PARAM="N",PRTDTI Q
|
|---|
| 26 | .. S PTNM=$$GET1^DIQ(52.91,DFN,.01),PRTDT=$$FMTE^XLFDT(PRTDTI,"2D")
|
|---|
| 27 | .. S ^TMP($J,"PSOTPBLR",DIVDA,PTNM,DFN)=PRTDT
|
|---|
| 28 | .. S DIVCNT(DIVDA)=$G(DIVCNT(DIVDA))+1
|
|---|
| 29 | PRINT ; print report
|
|---|
| 30 | U IO K DIVCNT,PSOSTOP
|
|---|
| 31 | S PG=0,LINE="",$P(LINE,"=",79)=""
|
|---|
| 32 | S DIVDA=0 F Q:$G(PSOSTOP) S DIVDA=$O(^TMP($J,"PSOTPBLR",DIVDA)) Q:DIVDA'>0 D
|
|---|
| 33 | . D HEADER
|
|---|
| 34 | . S PTNM="" F Q:$G(PSOSTOP) S PTNM=$O(^TMP($J,"PSOTPBLR",DIVDA,PTNM)) Q:PTNM="" D
|
|---|
| 35 | .. S DFN=0 F Q:$G(PSOSTOP) S DFN=$O(^TMP($J,"PSOTPBLR",DIVDA,PTNM,DFN)) Q:DFN'>0 D
|
|---|
| 36 | ... S DIVCNT(DIVDA)=$G(DIVCNT(DIVDA))+1
|
|---|
| 37 | ... D PG
|
|---|
| 38 | ... W !,$$GET1^DIQ(52.91,DFN,.01)
|
|---|
| 39 | ... I PARAM="P" W ?35,^TMP($J,"PSOTPBLR",DIVDA,PTNM,DFN) Q
|
|---|
| 40 | ... S INACTDT=$$GET1^DIQ(52.91,DFN,2,"I"),EXCODE=$$GET1^DIQ(52.91,DFN,3),EXREA=$$GET1^DIQ(52.91,DFN,8)
|
|---|
| 41 | ... W:INACTDT ?35,$$FMTE^XLFDT(INACTDT,"2D") W:$L(EXCODE) ?45,EXCODE
|
|---|
| 42 | ... W:$L(EXREA) !,?10,"Exclusion Reason: ",EXREA
|
|---|
| 43 | SUMMARY ;
|
|---|
| 44 | W:'$D(DIVCNT) !!,"No Data Found"
|
|---|
| 45 | Q:$G(PSOSTOP)
|
|---|
| 46 | I PG,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR I 'Y S PSOSTOP=1 Q
|
|---|
| 47 | W !,@IOF,!!,?10,"SUMMARY of TPB LETTER PRINTING "
|
|---|
| 48 | I PARAM="P" W "'PRINTED'" I 1
|
|---|
| 49 | E W "'NOT PRINTED'"
|
|---|
| 50 | W !!
|
|---|
| 51 | S DIVDA=0 F S DIVDA=$O(DIVCNT(DIVDA)) Q:DIVDA'>0 D
|
|---|
| 52 | . W !,?5,$$GET1^DIQ(52.92,DIVDA,.01),?40,DIVCNT(DIVDA)
|
|---|
| 53 | W:'$D(DIVCNT) !!,"No Data Found"
|
|---|
| 54 | W !
|
|---|
| 55 | G EXIT
|
|---|
| 56 | ;
|
|---|
| 57 | PG I $Y>(IOSL-4) D HEADER
|
|---|
| 58 | Q
|
|---|
| 59 | HEADER ;
|
|---|
| 60 | W !
|
|---|
| 61 | I PG,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR I 'Y S PSOSTOP=1 Q
|
|---|
| 62 | W @IOF
|
|---|
| 63 | S PG=PG+1
|
|---|
| 64 | W ?20,$$GET1^DIQ(52.92,DIVDA,.01)
|
|---|
| 65 | I PARAM="P" W " TPB PATIENTS LETTERS PRINTED REPORT",! I 1
|
|---|
| 66 | E W " TPB PATIENTS LETTERS NOT PRINTED REPORT",!
|
|---|
| 67 | W ?28,$$FMTE^XLFDT(DT,"1D"),?60,"Page: ",PG,!,LINE
|
|---|
| 68 | I PARAM="N" W !,?35,"Inactivation",!,"Patient",?35,"Date",?45,"Reason",!
|
|---|
| 69 | Q
|
|---|
| 70 | EXIT ;
|
|---|
| 71 | I $E(IOST)="C" W !!,"End of Report",! K DIR S DIR(0)="EO",DIR("A")="<cr> - Continue" D ^DIR
|
|---|
| 72 | K ^TMP($J,"PSOTPBLR") I $G(ZTSK) D KILL^%ZTLOAD
|
|---|
| 73 | EXIT2 D ^%ZISC
|
|---|
| 74 | K DIR,DIVCNT,DIVDA,LINE,PARAM,PG,PRTDT,PRTDTI,PTNM,SRDT
|
|---|
| 75 | Q
|
|---|
