source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPOLY.m@ 1704

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

initial load of WorldVistAEHR

File size: 6.4 KB
Line 
1PSOPOLY ;BHAM ISC/SAB - patients with a minimum amount of rx's within a # of days ;10/06/93
2 ;;7.0;OUTPATIENT PHARMACY;**19,28,132**;DEC 1997
3 ;External reference ^PS(55 supported by DBIA# 2228
4 ;External reference ^PSDRUG( supported by DBIA# 221
5 ;External reference ^DPT( supported by DBIA# 10035
6 ;External reference ^PS(50.606 supported by DBIA 2174
7 ;External reference ^PS(50.7 supported by DBIA 2223
8 K ^TMP($J),DIR S PG=0
9 S DIR("A")="Number Of Days To Begin Search",DIR("?")="^D HLP^PSOPOLY",DIR(0)="N^1:730:0",DIR("B")=180 D ^DIR G:$D(DIRUT) END S DAYS=Y K DIR
10 S DIR("A")="Minimum Number Of Rxs and Active Non-VA Meds",DIR("B")=7,DIR("?")="^D HLP1^PSOPOLY",DIR(0)="N^1:100:0" D ^DIR G:$D(DIRUT) END S RX=Y K DIR
11PAT R !!,"Enter Patient's Name or ^ALL for All Patients: ",X:DTIME G:'$T END G:$E(X,1,2)="^A"!($E(X,1,2)="^a") ALL
12 S DIC(0)="QEM",DIC="^DPT(" D ^DIC G:"^"[$E(X) END G:Y<0 PAT S (PSODFN,DFN)=+Y
13 D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN) S ALL=0 D DEV G:$G(QP)!($D(ZTSK)) END
14ENQ D CON,PID^VADPT S DFN=PSODFN I '$O(^PS(55,DFN,"P","A",PSDATE)),'$O(^PS(55,DFN,"NVA",0)) G NRX
15BEG S RXS=0 S:$G(PSDATEX) PSDATE=PSDATEX
16 F S PSDATE=$O(^PS(55,DFN,"P","A",PSDATE)) Q:'PSDATE S (P,J)=0 F S J=$O(^PS(55,DFN,"P","A",PSDATE,J)) Q:'J D:$D(^PSRX(J,0))
17 .I 134'[$E(+$P($G(^PSRX(J,"STA")),"^")),$P($G(^PSDRUG($P($G(^PSRX(J,0)),"^",6),0)),"^",3)'["S" S RXS=RXS+1,RX(DFN,J)=+$P($G(^PSRX(J,"STA")),"^")
18 N NVA F NVA=0:0 S NVA=$O(^PS(55,DFN,"NVA",NVA)) Q:'NVA I '$P(^PS(55,DFN,"NVA",NVA,0),"^",7) S RXS=RXS+1
19 I RXS'<RX F S P=$O(RX(DFN,P)) Q:'P S RX0=$S($D(^PSRX(P,0)):^(0),1:""),RX2=$S($D(^(2)):^(2),1:""),RX3=$S($D(^(3)):^(3),1:"") D
20 .S STA=RX(DFN,P),DRUG=$S($D(^PSDRUG($P(RX0,"^",6),0)):$P(^PSDRUG($P(RX0,"^",6),0),"^"),1:"UNKNOWN"),CLASS=$S($P($G(^PSDRUG($P(RX0,"^",6),0)),"^",2)]"":$P(^(0),"^",2),1:"UNKNOWN")
21A .S STAT="A^N^R^H^N^S^^^^^^E^DC^^DC^DE^H^P^",STATUS=$P(STAT,"^",STA+1)
22 .S FILLDATE=9999999-$P(^PSRX(P,2),"^",2)
23 .S ^TMP($J,$P(^DPT(DFN,0),"^"),CLASS,DRUG,FILLDATE,P)=$P(^PSRX(P,0),"^",2)_"^"_RXS_"^"_$P(RX3,"^")_"^"_$P(RX0,"^",4)_"^"_STATUS_"^"_VA("BID")_"^"_DFN
24 I RXS'<RX,$O(^TMP($J,$P(^DPT(DFN,0),"^"),""))="" S CLASS="NVA",^TMP($J,$P(^DPT(DFN,0),"^"),CLASS)=DFN_"^"_RXS
25 S RXS=0 K RX(DFN),CLASS
26 I 'ALL,'$D(^TMP($J)) G NRX
27 I 'ALL D PRI G:$G(PSOTRUE) END D NVA G END
28 Q
29 ;
30PRI S PG=0 D HDR S (DFN,ZDFN)="" D
31 .F S DFN=$O(^TMP($J,DFN)) Q:DFN="" S (ZCLASS,CLASS)="" D I ALL,$G(CLASS)="" D:'$G(PSOTRUE) NVA K PSOTRUE W ! F I=1:1:132 W "-"
32 ..F S CLASS=$O(^TMP($J,DFN,CLASS)) Q:CLASS="" D
33 ...I CLASS="NVA" S PSODFN=$P(^TMP($J,DFN,"NVA"),"^"),PSOTRUE=1 D NVA Q
34 ...S DRUG="" F S DRUG=$O(^TMP($J,DFN,CLASS,DRUG)) Q:DRUG="" S FILLDATE="" F S FILLDATE=$O(^TMP($J,DFN,CLASS,DRUG,FILLDATE)) Q:'FILLDATE D
35 ....F RNX=0:0 S RNX=$O(^TMP($J,DFN,CLASS,DRUG,FILLDATE,RNX)) Q:'RNX S POLY=^(RNX),PSODFN=$P(POLY,"^",7) D
36 .....I ($Y+5)>IOSL D HDR
37 .....W ! W:ZDFN'=DFN !,DFN_" ("_$P(POLY,"^",6)_")" W:ZDFN'=DFN ?65,$J($P(POLY,"^",2),3),! W:ZCLASS'=CLASS ?2,$E(CLASS,1,16)
38 .....W ?22,DRUG,?65,$P(POLY,"^",5) S Y=$P(POLY,"^",3) W ?77 D DT^DIQ S PROV=$P($G(^VA(200,$P(POLY,"^",4),0)),"^") W ?92,$E(PROV,1,25),?121,$P(^PSRX(RNX,0),"^") S ZCLASS=CLASS,ZDFN=DFN
39 .....S TOTRX=$G(TOTRX)+1 S:'$D(^TMP($J,"PAT",DFN)) TOTP=$G(TOTP)+1,^TMP($J,"PAT",DFN)=""
40 I ALL U IO W !!,"Total Number of Patients: "_TOTP,?40,"Total Number of Rxs: "_TOTRX,?80,"Average Rxs per Patient: "_(TOTRX\TOTP)
41 Q
42END W ! D ^%ZISC K QP,^TMP($J),DIR,DTOUT,DUOUT,DIRUT,DIROUT,%DT,ALL,CLASS,DAYS,DFN,DIC,DRUG,EDT,FILLDATE,PSDATEX,G,I,J,P,PSDATE,RX,RXS,RX0,RX2,RX3,SDT,X,Y,POLY,PROV,POP,RNX,Z0,Z1,Z2,ZCLASS,PG,ZDFN,ZTSK,STA,STAT,STATUS D KVA^VADPT
43 K PSODFN,PAT,TOTRX,TOTP S:$D(ZTQUEUED) ZTREQ="@"
44 Q
45ALL ;print all patients
46 W ! S ALL=1,(TOTRX,TOTP)=0 D DEV G:$G(QP)!($D(ZTSK)) END
47ALLP D CON
48 F DFN=0:0 S DFN=$O(^PS(55,DFN)) Q:'DFN S ALL=1 D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN) D PID^VADPT,BEG
49 I '$D(^TMP($J)) G NRX
50 D PRI,END
51 Q
52CON ;convert data to date
53 S %DT="",X="T-"_DAYS D ^%DT S SDT=Y,(PSDATE,PSDATEX)=SDT-1,X="T" D ^%DT S EDT=Y,RXS=0
54 Q
55NRX ;prints no rx message
56 D HDR U IO W:'ALL !,$P(^DPT(DFN,0),"^")_" ("_VA("BID")_")" W !?20,">>>> No Active Prescriptions and/or Non-VA Meds found within the Range <<<<" W @IOF G END
57 Q
58HLP ;help module
59 W !!,$C(7),"Enter numeric value greater than zero.",!,"The value must a whole number, no decimals or fractions.",!!
60 Q
61HLP1 W !!,$C(7),"Enter a numeric value greater than zero.",!,"The number seven (7) is the default, no decimals or fractions.",!,"The count will include both Active Prescriptions and Non-VA Medications.",!!
62 Q
63DEV K %ZIS,IOP,ZTSK S %ZIS("B")="",PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S QP=1,IOP=PSOION D ^%ZIS K IOP,PSOION Q
64 I $G(IOM)<132 W $C(7),!!,"Printout Must be 132 Columns.",!! G DEV
65 K PSOION I $D(IO("Q")) D K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is queued to print !",!
66 .S ZTDESC="Poly Pharmacy Report",ZTRTN=$S('ALL:"ENQ^PSOPOLY",1:"ALLP^PSOPOLY") F G="ALL","RX","DAYS","DFN","PG","PSODFN" S:$D(@G) ZTSAVE(G)=""
67 Q
68HDR ;report header
69 S PG=PG+1 U IO W @IOF,?55,"Poly Pharmacy Report",!?50,$E(SDT,4,5)_"-"_$E(SDT,6,7)_"-"_($E(SDT,1,3)+1700)_" to "_$E(EDT,4,5)_"-"_$E(EDT,6,7)_"-"_($E(EDT,1,3)+1700)
70 W !?37," for "_DAYS_" Days for "_RX_" or More Active Prescriptions and/or Non-VA Meds"
71 W ?122,"Page "_PG,!,"Patient",?40,"ID#",?62,"Active Rx's",!,?2,"Class",?22,"Drug",?65,"Status",?77,"Last Filled",?92,"Provider",?121,"Rx Number"
72 W ! F I=1:1:132 W "-"
73 Q
74NVA ;displays non-va meds
75 Q:'$O(^PS(55,PSODFN,"NVA",0)) N TITLE
76 S PSOSTA=">>>Non-VA MEDS (Not dispensed by VA)<<<"
77 S STR=($L(PSOSTA)+IOM/2)-$L(PSOSTA),STP=IOM-(STR+$L(PSOSTA)) F I=1:1:STR S TITLE=$G(TITLE)_" "
78 S TITLE=TITLE_PSOSTA F I=1:1:STP S TITLE=TITLE_" "
79 ;S TITLE=TITLE_"*"
80 D:($Y+7)>IOSL HDR W !!,TITLE
81 I $G(CLASS)="NVA" W !,DFN_" ("_VA("BID")_")",?40,"Total Non-VA Meds: "_$P(^TMP($J,DFN,CLASS),"^",2)
82 F NVAO=0:0 S NVAO=$O(^PS(55,PSODFN,"NVA",NVAO)) Q:'NVAO D
83 .Q:$P(^PS(55,PSODFN,"NVA",NVAO,0),"^",7) Q:'$P(^PS(55,PSODFN,"NVA",NVAO,0),"^")
84 .S DUPRX0=^PS(55,PSODFN,"NVA",NVAO,0)
85 .I ($Y+7)>IOSL D HDR W !!,TITLE,!,$P(^DPT(PSODFN,0),"^")_" ("_VA("BID")_")"
86 .S DOI=$S($P(DUPRX0,"^",2):$P(^PSDRUG($P(DUPRX0,"^",2),0),"^"),1:$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"))
87 .W !?2,DOI_" "_$P(DUPRX0,"^",3)
88 .W !?5,"Schedule: "_$P(DUPRX0,"^",5)
89 .W !?5,"Start Date: "_$$FMTE^XLFDT($P(DUPRX0,"^",9)),?45," Documented: "_$$FMTE^XLFDT($P(DUPRX0,"^",10)) ;_" Status: Active"
90 K DUPRX0,NVA,STP,STR,PSOSTA,TITLE,DOI
91 Q
Note: See TracBrowser for help on using the repository browser.