source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOTPRP1.m@ 1267

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1PSOTPRP1 ;BIR/MR - Report of Patients with TPB and Non-TBP Active Rx's ;12/03/03
2 ;;7.0;OUTPATIENT PHARMACY;**160,227**;DEC 1997
3 ;
4EN ;
5 Q ;placed out of order by PSO*7*227
6 N OINAM,INS,INSNAM,VADM,TYPE,DRGIEN,TPBRXCNT,SEQ,DFN,RXIEN,RXEXT,RX,POP
7 N PSOPAT,PSOAINS,PATNAM,PATCNT,PAT,PAG,INST,PATSSN,PSOAPT,VARXCNT,Y
8 ;
9 W !!,"This report prints entries from the TPB ELIGIBILITY file (#52.91)."
10 W !,"If multiple Institutions are selected, and some Institutions have data and"
11 W !,"some don't, only those Institutions that have data will print on the report.",!
12 ;
13 ;Ask for Institutions
14 N DIC,X,I K PSOINS S PSOAINS=0
15 W !,?5,"You may select a single or multiple INSTITUTIONS,"
16 W !,?5,"or enter ^ALL to select all INSTITUTIONS.",!
17 S DIC=4,DIC(0)="QEAM",DIC("A")=" INSTITUTION: "
18 F D ^DIC Q:Y<0 S PSOINS(+Y)="" K DIC("B")
19 I X="^ALL" S PSOAINS=1 K PSOINS,DUOUT G PAT
20 I $D(DUOUT)!($D(DTOUT)) G END
21 I '$D(PSOINS)&(Y<0) G END
22 ;
23PAT ; - Selection of PATIENTS to print on the Report
24 N DIC,X,I K PSOPT S PSOAPT=0
25 W !!,?5,"You may select a single or multiple PATIENTS,"
26 W !,?5,"or enter ^ALL to select all PATIENTS.",!
27 S DIC=2,DIC(0)="QEAM",DIC("A")=" PATIENT: "
28 S DIC("S")="I $D(^PS(52.91,+Y))"
29 F D ^DIC Q:Y<0 S PSOPT(+Y)="" K DIC("B")
30 I X="^ALL" S PSOAPT=1 K PSOPT,DUOUT G DEV
31 I $D(DUOUT)!($D(DTOUT)) G END
32 I '$D(PSOPT)&(Y<0) G END
33 ;
34DEV W ! K %ZIS,IOP,POP,ZTSK S %ZIS="QM" D ^%ZIS K %ZIS I POP G END
35 I $D(IO("Q")) D G END
36 . N VAR K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK S ZTRTN="RPT^PSOTPRP1"
37 . S ZTDESC="Report of Patients with TPB and Non-TPB Rx's"
38 . F VAR="PSOPT","PSOAPT","PSOINS","PSOAINS" S:$D(@VAR) ZTSAVE(VAR)=""
39 . S:$D(PSOPT) ZTSAVE("PSOPT(")="" S:$D(PSOINS) ZTSAVE("PSOINS(")=""
40 . D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!" K ZTSK
41 ;
42 G RPT
43 ;
44END K ^TMP("PSOTPB",$J)
45 Q
46 ;
47RPT ;- Print the Report
48 ;
49SORT ;- Sort the Data by Institution,Patient Name
50 S DFN=0 K ^TMP("PSOTPB",$J)
51 ;
52 ;- ALL Patients
53 I PSOAPT D G PRINT
54 . F S DFN=$O(^PS(52.91,DFN)) Q:'DFN D STMP
55 ;
56 ;- Selected Patiens
57 F S DFN=$O(PSOPT(DFN)) Q:'DFN D STMP
58 ;
59PRINT ;- Read TMP global and Print Report
60 S PAG=0
61 I '$D(^TMP("PSOTPB",$J)) D G END
62 . D HDR W !!?30,"*** NO DATA TO PRINT ***"
63 ;
64 S (INS,PAT,TYPE,RX)=""
65 F S INS=$O(^TMP("PSOTPB",$J,INS)) Q:INS="" D I $D(DIRUT) Q
66 . D HDR I $D(DIRUT) Q
67 . S (PATCNT,VARXCNT,TPBRXCNT)=0
68 . F S PAT=$O(^TMP("PSOTPB",$J,INS,PAT)) Q:PAT="" D I $D(DIRUT) Q
69 . . W !,PAT
70 . . F S TYPE=$O(^TMP("PSOTPB",$J,INS,PAT,TYPE)) Q:TYPE="" D I $D(DIRUT) Q
71 . . . F S RX=$O(^TMP("PSOTPB",$J,INS,PAT,TYPE,RX)) Q:RX="" D I $D(DIRUT) Q
72 . . . . I $Y>(IOSL-4) D HDR Q:$D(DIRUT) W !,PAT
73 . . . . S RXEXT=$$GET1^DIQ(52,RX,.01),DRGIEN=$$GET1^DIQ(52,RX,6)
74 . . . . S OINAM=$$GET1^DIQ(50,DRGIEN,2.1) S:OINAM="" OINAM=$$GET1^DIQ(52,RX,6)
75 . . . . W ?$S(TYPE=0:30,1:42),RXEXT,?54,$E(OINAM,1,26),!
76 . . . . S:TYPE=0 VARXCNT=VARXCNT+1 S:TYPE=1 TPBRXCNT=TPBRXCNT+1
77 . . S PATCNT=PATCNT+1
78 . I '$D(DIRUT) D
79 . . W !,"TOTAL ",INS,": ",PATCNT," Patient(s) ",VARXCNT," VA Prescriptions"
80 . . W TPBRXCNT," TPB Prescriptions."
81 Q
82 ;
83STMP ;- Set Temporary Global (^TMP)
84 ;
85 ;- Check the Patient Instituion
86 S INS=$$GET1^DIQ(52.91,DFN,7,"I")
87 I 'PSOAINS,'$D(PSOINS(INS)) Q
88 S INSNAM="Institution Missing" I INS S INSNAM=$$GET1^DIQ(4,INS,.01)
89 ;
90 ;- Get Patient Information (Name,SSN)
91 D DEM^VADPT S PATNAM=$P(VADM(1),U) S:PATNAM="" PATNAM="Patient Missing"
92 S PATSSN=$P($P(VADM(2),U,2),"-",3)
93 S PATNAM=$E(PATNAM,1,22)_"("_PATSSN_")"
94 ;
95 ;Start Loop of PHARMACY PATIENT (#55)
96 S (SEQ,VARXCNT,TPBRXCNT)=0
97 F S SEQ=$O(^PS(55,DFN,"P",SEQ)) Q:'SEQ D
98 . ;Get Prescription Number
99 . S RXIEN=$G(^PS(55,DFN,"P",SEQ,0)) I $G(^PSRX(RXIEN,0))="" Q
100 . ;
101 . ;- Rx not Active
102 . I '$$ACTIVE^PSOTPCUL(RXIEN) Q
103 . ;
104 . ;- VA or TPB prescription
105 . S TYPE=$S($$GET1^DIQ(52,RXIEN,201,"I"):1,1:0)
106 . S:TYPE=0 VARXCNT=VARXCNT+1 S:TYPE=1 TPBRXCNT=TPBRXCNT+1
107 . ;
108 . S ^TMP("PSOTPB",$J,INSNAM,PATNAM,TYPE,RXIEN)=""
109 ;
110 ;- VA and TPB Active prescritpions must be found
111 I (VARXCNT'>0)!(TPBRXCNT'>0) K ^TMP("PSOTPB",$J,INSNAM,PATNAM)
112 Q
113 ;
114HDR ; - Prints the Header
115 N X,DIR S PAG=$G(PAG)+1
116 I PAG>1,$E(IOST)="C" D Q:$D(DIRUT)
117 . F Q:$Y>(IOSL-2) W !
118 . S DIR(0)="E",DIR("A")=" Press ENTER to Continue or ^ to Exit" D ^DIR
119 ;
120 W @IOF,!,"REPORT OF PATIENTS WITH TPB AND NON-TBP RX's ON FILE",?70,"Page: ",$J(PAG,3)
121 W !,?48,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT())
122 W:$G(INST)'="" !,"INSTITUTION: ",INS
123 S X="",$P(X,"-",80)="" W !,X
124 W !,"PATIENT (LAST4SSN)",?30,"VA RX#",?42,"TPB RX#",?54,"DRUG"
125 W !,X
126 Q
Note: See TracBrowser for help on using the repository browser.