| [613] | 1 | PSOPOLY ;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
|
|---|
| 11 | PAT 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
|
|---|
| 14 | ENQ D CON,PID^VADPT S DFN=PSODFN I '$O(^PS(55,DFN,"P","A",PSDATE)),'$O(^PS(55,DFN,"NVA",0)) G NRX
|
|---|
| 15 | BEG 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")
|
|---|
| 21 | A .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 | ;
|
|---|
| 30 | PRI 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
|
|---|
| 42 | END 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
|
|---|
| 45 | ALL ;print all patients
|
|---|
| 46 | W ! S ALL=1,(TOTRX,TOTP)=0 D DEV G:$G(QP)!($D(ZTSK)) END
|
|---|
| 47 | ALLP 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
|
|---|
| 52 | CON ;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
|
|---|
| 55 | NRX ;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
|
|---|
| 58 | HLP ;help module
|
|---|
| 59 | W !!,$C(7),"Enter numeric value greater than zero.",!,"The value must a whole number, no decimals or fractions.",!!
|
|---|
| 60 | Q
|
|---|
| 61 | HLP1 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
|
|---|
| 63 | DEV 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
|
|---|
| 68 | HDR ;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
|
|---|
| 74 | NVA ;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
|
|---|
