source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOSDP.m@ 636

PSOSDP ;BHAM ISC/SAB - poly pharmacy report attached to action/info profile ;12/13/93 8:24
 ;;7.0;OUTPATIENT PHARMACY;**2,17,19,107,110,155,176,233,258**;DEC 1997;Build 4
 ;called from PSOSD
 Q:+$G(^TMP($J,DFN))<PSONUM!($G(DOD(DFN))]"")  S DRG="",P=0,PSOPOLP=0 D HD K SGY
 F  S DRG=$O(^TMP($J,DFN,DRG)) Q:DRG=""  F  S P=$O(^TMP($J,DFN,DRG,P)) Q:'P  I $G(^PSRX(P,0))]"" S RX0=^PSRX(P,0),RX2=$G(^(2)),RX3=$G(^(3)) D  K SGY
 .I $Y+6>IOSL D FT,HD
 .S SIG=$P($G(^PSRX(P,"SIG")),"^") W !?10,"* "_$E(DRG,1,40),?52 D SIG W $G(BSIG(1)),?79,"*"
 .;F PSOGY=2:1 Q:$G(SGY(PSOGY))=""  W !?10,"*",?52,SGY(PSOGY),?79,"*" I $Y+4>IOSL,$O(SGY(PSOGY)) D FT,HD
 .I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV  W !?10,"*",?52,$G(BSIG(PSREV)),?79,"*" I $Y+4>IOSL,$O(BSIG(PSREV)) D FT,HD
 .K BSIG,PSREV
 D FT K PSOGY
 Q
SIG K FSIG,BSIG I $P($G(^PSRX(P,"SIG")),"^",2) D FSIG^PSOUTLA("R",P,26) F PSREV=1:1 Q:'$D(FSIG(PSREV))  S BSIG(PSREV)=FSIG(PSREV)
 K FSIG,PSREV I '$P($G(^PSRX(P,"SIG")),"^",2) D EN3^PSOUTLA1(P,26)
 Q
HD S FN=DFN
 D ELIG^PSOSD1,DEM^VADPT,INP^VADPT,ADD^VADPT,PID^VADPT S PSSN=VA("PID"),ADDRFL=$S(+VAPA(9):"Temporary ",1:"")
 S PSNAME=$E(VADM(1),1,28),PSDOB=$P(VADM(3),"^",2)
 W @IOF,!,"Polypharmacy Rx Profile Review",?47,"Run Date: " S Y=DT D DT^DIO2 W ?71,"Page: "_PAGE S PAGE=PAGE+1,X=$$SITE^VASITE
 W !,"Sorted by drug name for Rx's currently active",@$S(PSORM:"?70",1:"!"),"Site: VAMC "_$P(X,"^",2)_"( "_$P(X,"^",3)_")",!,$E(LINE,1,$S('PSORM:80,1:IOM)-1)
 I $D(CLINICX) W !?1,"Clinic: ",$E(CLINICX,1,28),?45,"Date/Time: " S Y=CLDT D DT^DIO2
 W !?1,"Name  : ",PSNAME,?30,"ID#: "_VA("BID") W ?58,"Review Date: ________" W !?1,"DOB   : "_PSDOB
 W:ADDRFL]"" ?30,ADDRFL,! W ?30,"Address  :"
 I ADDRFL="" D CHECKBAI^PSOSD1
 W ?41,VAPA(1) W:VAPA(2)]"" !?41,VAPA(2) W:VAPA(3)]"" !?41,VAPA(3) W !?41,VAPA(4)_", "_$P(VAPA(5),"^",2)_"  "_VAPA(6),!?30,"Phone    : "_VAPA(8)
 S PSOBAR2=PSOBAR0,PSOBAR3=PSOBAR1
 S PSOBAR4=$G(PSOBAR3)]""&($G(PSOBAR2)]"")&(+$P($G(PSOPAR),"^"))
 I PSOBAR4 S X="S",X2=PSSN W @$S('PSORM:"!?30",1:"?$X+5") S X1=$X W @PSOBAR3,X2,@PSOBAR2,$C(13) S $X=0
 F GMRVSTR="WT","HT" S VM=GMRVSTR D EN6^GMRVUTL S @VM=X,$P(@VM,"^")=$E($P(@VM,"^"),4,5)_"/"_$E($P(@VM,"^"),6,7)_"/"_($E($P(@VM,"^"),1,3)+1700)
 S X=$P(WT,"^",8),Y=$J(X/2.2,0,2),WT=WT_"^"_Y,X=$P(HT,"^",8),Y=$J(2.54*X,0,2),HT=HT_"^"_Y
 W !?1,"WEIGHT(Kg): " W:+$P(WT,"^",8) $P(WT,"^",9)_" ("_$P(WT,"^")_")" W ?41,"HEIGHT(cm): " W:$P(HT,"^",8) $P(HT,"^",9)_" ("_$P(HT,"^")_")" K VM,WT,HT
 W !,$E(LINE,1,$S('PSORM:80,1:IOM)-1),!!!?10 F I=1:1:70 W "*"
 W !?10,"*",?35,"POLYPHARMACY REVIEW",?79,"*",!?10,"*",?79,"*",!?10,"* Patient:  "_PSNAME,?50,"(ID#: "_VA("BID")_")",?79,"*"
 W !?10,"* is identified as having "_PSONUM_" or more active prescriptions",?79,"*",!?10,"* for drugs (excluding supplies).  To avoid unnecessary",?79,"*"
 W !?10,"* medications, please review these to ensure that each one",?79,"*",!?10,"* is essential.  Unnecessary medications may be discontinued on",?79,"*"
 W !?10,"* the attached Action Profile.",?79,"*",!?10,"*",?79,"*",!?10,"* I have reviewed the medications below and have taken",?79,"*",!?10,"* actions to discontinue those that are no longer required.",?79,"*"
 F I=1:1:3 W !?10,"*",?79,"*"
 W !?10,"*",?25 F I=1:1:35 W "_"
 W ?79,"*",!?10,"*",?25,"(Signature)",?79,"*" F I=1:1:2 W !?10,"*",?79,"*"
 W !?10,"*",?25,"Drugs ("_^TMP($J,DFN)_")",?60,"SIG",?79,"*"
 W !?10,"* " F I=1:1:30 W "-"
 W ?52 F I=1:1:20 W "-"
 W ?79,"*"
 Q
FT W !?10 F I=1:1:70 W "*"
 Q
CLSG ;clinic group sort and print
 S CLSP=1,DIC("A")="Select Clinic Sort Group: "
 S DIC="^PS(59.8,",DIC(0)="AEQM" D ^DIC G:"^"[X EXIT^PSOSD G:Y<0 CLSG
 S CLSG=+Y
 I '$O(^PS(59.8,CLSG,1,0)) W !!,$C(7),"There are no clinics defined for this Clinic Group!",!,$C(7) G CLSG
 S %DT="AEFX",%DT("A")="FOR DATE: " D ^%DT G:"^"[X EXIT^PSOSD G CLSG:Y<0 S (APCLDT,CLDT)=Y,$P(LINE,"-",132)="-"
 D DAYS^PSOSD1 G:$D(DIRUT) EXIT S X1=DT,X2=-PSDAYS D C^%DTC S PSDATE=X S PSTYPE=$S($D(PSTYPE):PSTYPE,1:0)
 K %DT,%ZIS,IOP,ZTSK,ZTQUEUED S PSOION=ION,%ZIS="QM",%ZIS("B")="",%ZIS("A")=$S(PSTYPE:"Select a Printer: ",1:"DEVICE: ")
 S %ZIS("S")=$S(PSTYPE:"I $E($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0)),1)=""P""",1:"")
 N PSOBARS,PSOBAR0,PSOBAR1
 D ^%ZIS I POP S IOP=PSOION K PSOION G EXIT
 S APRT=ION ;D ^%ZISC
 K DTOUT,DIR,DIRUT
 ;S DIR(0)="Y",DIR("B")="NO",DIR("A")="DO YOU WANT YOUR OUTPUT QUEUED" D ^DIR G:$D(DIRUT) EXIT S APQUE=Y K X,Y,DIR,DIRUT,DTOUT
 W ! I $G(IO("Q")) D  W:$D(ZTSK) !,"Report Queued to Print !!",!! G EXIT
 .S %DT="ERXAFS",%DT("A")="Request Start Time: ",%DT("B")="NOW",%DT(0)="NOW" D ^%DT W ! Q:$D(DIRUT)!(X["^")  S APTM=Y
 .F G="LINE","CLDT","CLSG","PSOPOL","PSOSYS","PSOINST","PSOBAR3","PSOBAR4","PSOBAR2","PSOPAR","PSOPAR7","PRF","PSDAYS","PSDATE","PSTYPE","PSOSITE","PSDATE","PSDAY","PSONUM","PSORM" S:$D(@G) ZTSAVE(G)=""
 .S ZTSAVE("APCLDT")="",ZTDTH=APTM,ZTDESC="Clinic Sort Group Action Profile (Outpatient Pharmacy).",ZTSAVE("ZTREQ")="@",ZTSAVE("APRT")="",ZTIO=APRT,ZTRTN="EN^PSOSDP" D ^%ZTLOAD
 ;
EN ;
 S APIFLDS="1;2;3;4;5;6;7;8;9;10;11;12",ALL=1
 S CLN=0 ;S PSOIOS=IOS D DEVBAR^PSOBMST
 F  S CLN=$O(^PS(59.8,CLSG,1,CLN)) Q:'CLN  S FR=CLN_","_CLDT,PSOT=CLDT,TO=CLN_","_CLDT_".2359" D CLIN1^PSOSDRAP S CLDT=APCLDT
 D ^%ZISC
 ;
EXIT K ADDRFL,CAN,CLDT,CLINICX,CLSG,CLSP,CNT,CS,DFN,G,PAGE,PCLASS,PRF,PSDATE
 K PSDAY,PSDAYS,PSDT,PIIX,PSNAME,PSONUM,PSOT,PSSN,PSTYPE,RF,RFS,RXNO
 K RXNODE,PSORM,PSOUT,PSOION,ZTDESC,DQTIME,F,O,W,CLN,APQUE,APTM,APRT
 K APCLDT D KVA^VADPT,EXIT^PSOSD
 G:'$D(ZTQUEUED) ^PSOSD
 Q
 ;
COS I $P($G(^PSRX(J,3)),"^",3),$D(^VA(200,+$P($G(^(3)),"^",3),0)) W !?99,"COSIGNER: "_$P($G(^VA(200,$P(^PSRX(J,3),"^",3),0)),"^")
 Q