Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOTPCLR

PSOTPCLR.m

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