source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOSDP.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1PSOSDP ;BHAM ISC/SAB - poly pharmacy report attached to action/info profile ;12/13/93 8:24
2 ;;7.0;OUTPATIENT PHARMACY;**2,17,19,107,110,155,176,233,258**;DEC 1997;Build 4
3 ;called from PSOSD
4 Q:+$G(^TMP($J,DFN))<PSONUM!($G(DOD(DFN))]"") S DRG="",P=0,PSOPOLP=0 D HD K SGY
5 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
6 .I $Y+6>IOSL D FT,HD
7 .S SIG=$P($G(^PSRX(P,"SIG")),"^") W !?10,"* "_$E(DRG,1,40),?52 D SIG W $G(BSIG(1)),?79,"*"
8 .;F PSOGY=2:1 Q:$G(SGY(PSOGY))="" W !?10,"*",?52,SGY(PSOGY),?79,"*" I $Y+4>IOSL,$O(SGY(PSOGY)) D FT,HD
9 .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
10 .K BSIG,PSREV
11 D FT K PSOGY
12 Q
13SIG 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)
14 K FSIG,PSREV I '$P($G(^PSRX(P,"SIG")),"^",2) D EN3^PSOUTLA1(P,26)
15 Q
16HD S FN=DFN
17 D ELIG^PSOSD1,DEM^VADPT,INP^VADPT,ADD^VADPT,PID^VADPT S PSSN=VA("PID"),ADDRFL=$S(+VAPA(9):"Temporary ",1:"")
18 S PSNAME=$E(VADM(1),1,28),PSDOB=$P(VADM(3),"^",2)
19 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
20 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)
21 I $D(CLINICX) W !?1,"Clinic: ",$E(CLINICX,1,28),?45,"Date/Time: " S Y=CLDT D DT^DIO2
22 W !?1,"Name : ",PSNAME,?30,"ID#: "_VA("BID") W ?58,"Review Date: ________" W !?1,"DOB : "_PSDOB
23 W:ADDRFL]"" ?30,ADDRFL,! W ?30,"Address :"
24 I ADDRFL="" D CHECKBAI^PSOSD1
25 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)
26 S PSOBAR2=PSOBAR0,PSOBAR3=PSOBAR1
27 S PSOBAR4=$G(PSOBAR3)]""&($G(PSOBAR2)]"")&(+$P($G(PSOPAR),"^"))
28 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
29 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)
30 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
31 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
32 W !,$E(LINE,1,$S('PSORM:80,1:IOM)-1),!!!?10 F I=1:1:70 W "*"
33 W !?10,"*",?35,"POLYPHARMACY REVIEW",?79,"*",!?10,"*",?79,"*",!?10,"* Patient: "_PSNAME,?50,"(ID#: "_VA("BID")_")",?79,"*"
34 W !?10,"* is identified as having "_PSONUM_" or more active prescriptions",?79,"*",!?10,"* for drugs (excluding supplies). To avoid unnecessary",?79,"*"
35 W !?10,"* medications, please review these to ensure that each one",?79,"*",!?10,"* is essential. Unnecessary medications may be discontinued on",?79,"*"
36 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,"*"
37 F I=1:1:3 W !?10,"*",?79,"*"
38 W !?10,"*",?25 F I=1:1:35 W "_"
39 W ?79,"*",!?10,"*",?25,"(Signature)",?79,"*" F I=1:1:2 W !?10,"*",?79,"*"
40 W !?10,"*",?25,"Drugs ("_^TMP($J,DFN)_")",?60,"SIG",?79,"*"
41 W !?10,"* " F I=1:1:30 W "-"
42 W ?52 F I=1:1:20 W "-"
43 W ?79,"*"
44 Q
45FT W !?10 F I=1:1:70 W "*"
46 Q
47CLSG ;clinic group sort and print
48 S CLSP=1,DIC("A")="Select Clinic Sort Group: "
49 S DIC="^PS(59.8,",DIC(0)="AEQM" D ^DIC G:"^"[X EXIT^PSOSD G:Y<0 CLSG
50 S CLSG=+Y
51 I '$O(^PS(59.8,CLSG,1,0)) W !!,$C(7),"There are no clinics defined for this Clinic Group!",!,$C(7) G CLSG
52 S %DT="AEFX",%DT("A")="FOR DATE: " D ^%DT G:"^"[X EXIT^PSOSD G CLSG:Y<0 S (APCLDT,CLDT)=Y,$P(LINE,"-",132)="-"
53 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)
54 K %DT,%ZIS,IOP,ZTSK,ZTQUEUED S PSOION=ION,%ZIS="QM",%ZIS("B")="",%ZIS("A")=$S(PSTYPE:"Select a Printer: ",1:"DEVICE: ")
55 S %ZIS("S")=$S(PSTYPE:"I $E($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0)),1)=""P""",1:"")
56 N PSOBARS,PSOBAR0,PSOBAR1
57 D ^%ZIS I POP S IOP=PSOION K PSOION G EXIT
58 S APRT=ION ;D ^%ZISC
59 K DTOUT,DIR,DIRUT
60 ;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
61 W ! I $G(IO("Q")) D W:$D(ZTSK) !,"Report Queued to Print !!",!! G EXIT
62 .S %DT="ERXAFS",%DT("A")="Request Start Time: ",%DT("B")="NOW",%DT(0)="NOW" D ^%DT W ! Q:$D(DIRUT)!(X["^") S APTM=Y
63 .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)=""
64 .S ZTSAVE("APCLDT")="",ZTDTH=APTM,ZTDESC="Clinic Sort Group Action Profile (Outpatient Pharmacy).",ZTSAVE("ZTREQ")="@",ZTSAVE("APRT")="",ZTIO=APRT,ZTRTN="EN^PSOSDP" D ^%ZTLOAD
65 ;
66EN ;
67 S APIFLDS="1;2;3;4;5;6;7;8;9;10;11;12",ALL=1
68 S CLN=0 ;S PSOIOS=IOS D DEVBAR^PSOBMST
69 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
70 D ^%ZISC
71 ;
72EXIT K ADDRFL,CAN,CLDT,CLINICX,CLSG,CLSP,CNT,CS,DFN,G,PAGE,PCLASS,PRF,PSDATE
73 K PSDAY,PSDAYS,PSDT,PIIX,PSNAME,PSONUM,PSOT,PSSN,PSTYPE,RF,RFS,RXNO
74 K RXNODE,PSORM,PSOUT,PSOION,ZTDESC,DQTIME,F,O,W,CLN,APQUE,APTM,APRT
75 K APCLDT D KVA^VADPT,EXIT^PSOSD
76 G:'$D(ZTQUEUED) ^PSOSD
77 Q
78 ;
79COS 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)),"^")
80 Q
Note: See TracBrowser for help on using the repository browser.