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

PSOTPRP1.m

Go to the documentation of this file.
  1. PSOTPRP1 ;BIR/MR - Report of Patients with TPB and Non-TBP Active Rx's ;12/03/03
  1. ;;7.0;OUTPATIENT PHARMACY;**160,227**;DEC 1997
  1. ;
  1. EN ;
  1. Q ;placed out of order by PSO*7*227
  1. N OINAM,INS,INSNAM,VADM,TYPE,DRGIEN,TPBRXCNT,SEQ,DFN,RXIEN,RXEXT,RX,POP
  1. N PSOPAT,PSOAINS,PATNAM,PATCNT,PAT,PAG,INST,PATSSN,PSOAPT,VARXCNT,Y
  1. ;
  1. W !!,"This report prints entries from the TPB ELIGIBILITY file (#52.91)."
  1. W !,"If multiple Institutions are selected, and some Institutions have data and"
  1. W !,"some don't, only those Institutions that have data will print on the report.",!
  1. ;
  1. ;Ask for Institutions
  1. N DIC,X,I K PSOINS S PSOAINS=0
  1. W !,?5,"You may select a single or multiple INSTITUTIONS,"
  1. W !,?5,"or enter ^ALL to select all INSTITUTIONS.",!
  1. S DIC=4,DIC(0)="QEAM",DIC("A")=" INSTITUTION: "
  1. F D ^DIC Q:Y<0 S PSOINS(+Y)="" K DIC("B")
  1. I X="^ALL" S PSOAINS=1 K PSOINS,DUOUT G PAT
  1. I $D(DUOUT)!($D(DTOUT)) G END
  1. I '$D(PSOINS)&(Y<0) G END
  1. ;
  1. PAT ; - Selection of PATIENTS to print on the Report
  1. N DIC,X,I K PSOPT S PSOAPT=0
  1. W !!,?5,"You may select a single or multiple PATIENTS,"
  1. W !,?5,"or enter ^ALL to select all PATIENTS.",!
  1. S DIC=2,DIC(0)="QEAM",DIC("A")=" PATIENT: "
  1. S DIC("S")="I $D(^PS(52.91,+Y))"
  1. F D ^DIC Q:Y<0 S PSOPT(+Y)="" K DIC("B")
  1. I X="^ALL" S PSOAPT=1 K PSOPT,DUOUT G DEV
  1. I $D(DUOUT)!($D(DTOUT)) G END
  1. I '$D(PSOPT)&(Y<0) G END
  1. ;
  1. DEV W ! K %ZIS,IOP,POP,ZTSK S %ZIS="QM" D ^%ZIS K %ZIS I POP G END
  1. I $D(IO("Q")) D G END
  1. . N VAR K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK S ZTRTN="RPT^PSOTPRP1"
  1. . S ZTDESC="Report of Patients with TPB and Non-TPB Rx's"
  1. . F VAR="PSOPT","PSOAPT","PSOINS","PSOAINS" S:$D(@VAR) ZTSAVE(VAR)=""
  1. . S:$D(PSOPT) ZTSAVE("PSOPT(")="" S:$D(PSOINS) ZTSAVE("PSOINS(")=""
  1. . D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!" K ZTSK
  1. ;
  1. G RPT
  1. ;
  1. END K ^TMP("PSOTPB",$J)
  1. Q
  1. ;
  1. RPT ;- Print the Report
  1. ;
  1. SORT ;- Sort the Data by Institution,Patient Name
  1. S DFN=0 K ^TMP("PSOTPB",$J)
  1. ;
  1. ;- ALL Patients
  1. I PSOAPT D G PRINT
  1. . F S DFN=$O(^PS(52.91,DFN)) Q:'DFN D STMP
  1. ;
  1. ;- Selected Patiens
  1. F S DFN=$O(PSOPT(DFN)) Q:'DFN D STMP
  1. ;
  1. PRINT ;- Read TMP global and Print Report
  1. S PAG=0
  1. I '$D(^TMP("PSOTPB",$J)) D G END
  1. . D HDR W !!?30,"*** NO DATA TO PRINT ***"
  1. ;
  1. S (INS,PAT,TYPE,RX)=""
  1. F S INS=$O(^TMP("PSOTPB",$J,INS)) Q:INS="" D I $D(DIRUT) Q
  1. . D HDR I $D(DIRUT) Q
  1. . S (PATCNT,VARXCNT,TPBRXCNT)=0
  1. . F S PAT=$O(^TMP("PSOTPB",$J,INS,PAT)) Q:PAT="" D I $D(DIRUT) Q
  1. . . W !,PAT
  1. . . F S TYPE=$O(^TMP("PSOTPB",$J,INS,PAT,TYPE)) Q:TYPE="" D I $D(DIRUT) Q
  1. . . . F S RX=$O(^TMP("PSOTPB",$J,INS,PAT,TYPE,RX)) Q:RX="" D I $D(DIRUT) Q
  1. . . . . I $Y>(IOSL-4) D HDR Q:$D(DIRUT) W !,PAT
  1. . . . . S RXEXT=$$GET1^DIQ(52,RX,.01),DRGIEN=$$GET1^DIQ(52,RX,6)
  1. . . . . S OINAM=$$GET1^DIQ(50,DRGIEN,2.1) S:OINAM="" OINAM=$$GET1^DIQ(52,RX,6)
  1. . . . . W ?$S(TYPE=0:30,1:42),RXEXT,?54,$E(OINAM,1,26),!
  1. . . . . S:TYPE=0 VARXCNT=VARXCNT+1 S:TYPE=1 TPBRXCNT=TPBRXCNT+1
  1. . . S PATCNT=PATCNT+1
  1. . I '$D(DIRUT) D
  1. . . W !,"TOTAL ",INS,": ",PATCNT," Patient(s) ",VARXCNT," VA Prescriptions"
  1. . . W TPBRXCNT," TPB Prescriptions."
  1. Q
  1. ;
  1. STMP ;- Set Temporary Global (^TMP)
  1. ;
  1. ;- Check the Patient Instituion
  1. S INS=$$GET1^DIQ(52.91,DFN,7,"I")
  1. I 'PSOAINS,'$D(PSOINS(INS)) Q
  1. S INSNAM="Institution Missing" I INS S INSNAM=$$GET1^DIQ(4,INS,.01)
  1. ;
  1. ;- Get Patient Information (Name,SSN)
  1. D DEM^VADPT S PATNAM=$P(VADM(1),U) S:PATNAM="" PATNAM="Patient Missing"
  1. S PATSSN=$P($P(VADM(2),U,2),"-",3)
  1. S PATNAM=$E(PATNAM,1,22)_"("_PATSSN_")"
  1. ;
  1. ;Start Loop of PHARMACY PATIENT (#55)
  1. S (SEQ,VARXCNT,TPBRXCNT)=0
  1. F S SEQ=$O(^PS(55,DFN,"P",SEQ)) Q:'SEQ D
  1. . ;Get Prescription Number
  1. . S RXIEN=$G(^PS(55,DFN,"P",SEQ,0)) I $G(^PSRX(RXIEN,0))="" Q
  1. . ;
  1. . ;- Rx not Active
  1. . I '$$ACTIVE^PSOTPCUL(RXIEN) Q
  1. . ;
  1. . ;- VA or TPB prescription
  1. . S TYPE=$S($$GET1^DIQ(52,RXIEN,201,"I"):1,1:0)
  1. . S:TYPE=0 VARXCNT=VARXCNT+1 S:TYPE=1 TPBRXCNT=TPBRXCNT+1
  1. . ;
  1. . S ^TMP("PSOTPB",$J,INSNAM,PATNAM,TYPE,RXIEN)=""
  1. ;
  1. ;- VA and TPB Active prescritpions must be found
  1. I (VARXCNT'>0)!(TPBRXCNT'>0) K ^TMP("PSOTPB",$J,INSNAM,PATNAM)
  1. Q
  1. ;
  1. HDR ; - Prints the Header
  1. N X,DIR S PAG=$G(PAG)+1
  1. I PAG>1,$E(IOST)="C" D Q:$D(DIRUT)
  1. . F Q:$Y>(IOSL-2) W !
  1. . S DIR(0)="E",DIR("A")=" Press ENTER to Continue or ^ to Exit" D ^DIR
  1. ;
  1. W @IOF,!,"REPORT OF PATIENTS WITH TPB AND NON-TBP RX's ON FILE",?70,"Page: ",$J(PAG,3)
  1. W !,?48,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT())
  1. W:$G(INST)'="" !,"INSTITUTION: ",INS
  1. S X="",$P(X,"-",80)="" W !,X
  1. W !,"PATIENT (LAST4SSN)",?30,"VA RX#",?42,"TPB RX#",?54,"DRUG"
  1. W !,X
  1. Q