source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOTPCLR.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PSOTPCLR ;BIRM/PDW-LETTER PRINT REPORTS ;AUG 8, 2003
2 ;;7.0;OUTPATIENT PHARMACY;**145,227**;DEC 1997
3 Q
4EN ;
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
10DEVICE ;
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 ;
20DEQUE ; 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
29PRINT ; 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
43SUMMARY ;
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 ;
57PG I $Y>(IOSL-4) D HEADER
58 Q
59HEADER ;
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
70EXIT ;
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
73EXIT2 D ^%ZISC
74 K DIR,DIVCNT,DIVDA,LINE,PARAM,PG,PRTDT,PRTDTI,PTNM,SRDT
75 Q
Note: See TracBrowser for help on using the repository browser.