source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPRF.m@ 631

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1PSOPRF ;BHAM ISC/SAB - PRINTS A PROFILE ;11/18/92
2 ;;7.0;OUTPATIENT PHARMACY;**19,132**;DEC 1997
3 ;External reference to File #55 supported by DBIA 2228
4 ;External reference ^PS(50.606 supported by DBIA 2174
5 ;External reference ^PS(50.7 supported by DBIA 2223
6 ;External reference ^PSDRUG( supported by DBIA 221
7 ;PHARMACIST IN REVEIWING RX'S WHEN ADDING A 'NEW' RX
8Q D CUTDATE^PSOFUNC
9QOLD D PLBL^PSORXL
10 Q
11 ;
12DQ S:'$D(PFIO) PFIO=IO D START D KILL^%ZTLOAD Q
13 ;
14START D:('$D(PSOBMST)) EN1P^PSOBSET K Z S IOP=PFIO D ^%ZIS U IO I '$D(PSODTCUT) D CUTDATE^PSOFUNC
15 S:'$D(Z) Z=1 S:'$D(NEW1) (NEW1,NEW11)="^" S %DT="",X="T" D ^%DT S DT=Y S X1=DT,X2=-365 D C^%DTC S EXPS=X S X1=DT,X2=-182 D C^%DTC S EXP=X
16 K ^TMP($J,"PRF") S LINE="" F I=1:1:110 S LINE=LINE_"-"
17 F RXX=0:0 S RXX=$O(^PS(55,DFN,"P",RXX)) Q:'RXX S RXNN=+^(RXX,0) I $D(^PSRX(RXNN,0)),$P($G(^("STA")),"^")'=13 S RXPX=^PSRX(RXNN,0),$P(RXPX,"^",15)=$P($G(^("STA")),"^"),RXPX2=^(2) D CHK
18 D HD I '$D(^TMP($J,"PRF")) W !!?Z+15,"****** NO RX DATA ******",! G PPP
19 ;
20SD F SD="A","C","S" W:SD="S" !,?Z+1,"SUPPLIES",$E(LINE,1,89) I $D(^TMP($J,"PRF",SD)) S DRNME="" D DRNME
21PPP D PEND,NVA
22 W !!,"NAME: "_$P(^DPT(DFN,0),"^"),!,"ID#: "_VA("PID"),!
23 W:IOF]"" @IOF K ^TMP($J,"PRF"),A,B,DRNME,DRP,EXP,EXPS,I,II,ISSD,J,LINE,LN,MESS,MJK,NEW1,NEW11,PHYS,POP,QTY,TTTT,RFL,RFS,RXF,RXNN,RXPX,RXPX2,RXPNO,RXX,SD,SIG,STA,X,X1,X2,Y,Z
24 Q
25 ;
26DRNME S DRNME=$O(^TMP($J,"PRF",SD,DRNME)) Q:DRNME="" D ISSD G DRNME
27 ;
28ISSD F ISSD=0:0 S ISSD=$O(^TMP($J,"PRF",SD,DRNME,ISSD)) Q:'ISSD S RXPNO="" D RXPNO
29 Q
30 ;
31RXPNO S RXPNO=$O(^TMP($J,"PRF",SD,DRNME,ISSD,RXPNO)) Q:RXPNO="" S RXNN=^(RXPNO) I $D(^PSRX(RXNN,0)) S RXPX=^(0),RXPX2=^(2) D PRT G RXPNO
32 W "END***************"
33 ;
34CHK Q:PSODTCUT>$P(RXPX2,"^",6)
35 I $P(^PSRX(RXNN,"STA"),"^")=12 S II=RXNN D LAST^PSORFL Q:PSODTCUT>RFDATE
36 I $P(RXPX,"^",3)=7!($P(RXPX,"^",3)=8)&('PSOPRPAS) Q
37 S J="^"_RXNN_"^" Q:(NEW1[J)!(NEW11[J) Q:$P(RXPX,"^",13)<EXPS S RXPNO=$P(RXPX,"^"),ISSD=$P(RXPX,"^",13)
38 Q:'$D(^PSDRUG($P(RXPX,"^",6),0)) S DRP=^(0),SD=$S($P(DRP,"^",3)["S":"S",$P(RXPX,"^",15)=12:"C",1:"A"),DRNME=$P(DRP,"^"),^TMP($J,"PRF",SD,DRNME,ISSD,RXPNO)=RXNN
39 Q
40 ;
41PRT S RFS=$P(RXPX,"^",9),QTY=$P(RXPX,"^",7)
42 S PHYS=$S($D(^VA(200,$P(RXPX,"^",4),0)):$P(^(0),"^"),1:"UNKNOWN"),II=RXNN D LAST^PSORFL S RXF=0 F MJK=0:0 S MJK=$O(^PSRX(RXNN,1,MJK)) Q:'MJK S RXF=RXF+1
43 S STA=$S($P(^PSRX(RXNN,"STA"),"^")=14:"DC",$P(^PSRX(RXNN,"STA"),"^")=15:"DE",$P(^PSRX(RXNN,"STA"),"^")=16:"PH",1:$E("ANRHPS ECD",(1+$P(^PSRX(RXNN,"STA"),"^")))),STA=$S(DT>$P(RXPX2,"^",6):"E",1:STA)
44 W !,?Z+1,RXPNO,?Z+15,DRNME,?Z+55,$E(ISSD,4,5),"/",$E(ISSD,6,7)," ",$E(RFL,1,5)," ",?Z+67,$J(RFS,2)," ",$J(RXF,2)," ",?Z+73,$J(QTY,12)," ",?Z+86,STA," ",?Z+88,$E(PHYS,1,20)
45 D SIG F TTTT=0:0 S TTTT=$O(FSIG(TTTT)) Q:'TTTT W !,?Z+19,FSIG(TTTT)
46 Q
47 ;
48HD D PID^VADPT
49 W !,?Z+17,"PRESCRIPTION PROFILE AS OF ",$E(DT,4,5),"/",$E(DT,6,7),"/",($E(DT,1,3)+1700),!!,?Z+20,"NAME: "_$P(^DPT(DFN,0),"^"),!,?Z+20,"ID# : "_VA("PID")
50 I $D(^PS(55,DFN,1)) S MESS=^(1),LN=$L(MESS),A=0 W ! F B=1:1 Q:$P(MESS," ",B,99)="" W:$X>(Z+63) ! W ?Z+31,$P(MESS," ",B)," "
51 S X="PPPGET7" X ^%ZOSF("TEST") I I $$GETVIS^PPPGET7(DFN,"ZZ") K ZZ W !!,"THIS PATIENT HAS PRESCRIPTIONS AT OTHER FACILITIES" K ZZ
52 W !!?Z+20,"PHARMACIST: ___________________________ DATE: ____________"
53 W !!?Z+52," DATES ",?Z+67,"REFS ",?Z+86,"S"
54 W !?Z+1,"RX # ",?Z+15,"DRUG/STRENGTH/SIG",?Z+55,"ISSD LAST ",?Z+67,"AL AC",?Z+77,"QTY",?Z+86,"T",?Z+93,"PROVIDER"
55 W !?Z+1,$E(LINE,1,12),?Z+15,$E(LINE,1,35),?Z+55,"----- -----",?Z+67,"-- --",?Z+73,"------------",?Z+86,"-",?Z+88,$E(LINE,1,20)
56 Q
57SIG ;Format Sig
58 S PSPROSIG=$P($G(^PSRX(RXNN,"SIG")),"^",2) K FSIG,BSIG D
59 .I PSPROSIG D FSIG^PSOUTLA("R",RXNN,80) Q
60 .D EN2^PSOUTLA1(RXNN,80) F GGGGG=0:0 S GGGGG=$O(BSIG(GGGGG)) Q:'GGGGG S FSIG(GGGGG)=BSIG(GGGGG)
61 K PSPROSIG,GGGGG,BSIG Q
62PEND ;Print Pending Orders
63 N PSPCOUNT,PSPPEND,ZXXX,PSPSTAT,FSIGZZ,PZZDRUG,PSSODRUG,PZXZERO,PPPPP,GGGGG
64 S PSPCOUNT=1,PSPPEND="" F PPPPP=0:0 S PPPPP=$O(^PS(52.41,"P",DFN,PPPPP)) Q:'PPPPP S PSPSTAT=$P($G(^PS(52.41,PPPPP,0)),"^",3) I PSPSTAT="NW"!(PSPSTAT="HD")!(PSPSTAT="RNW") S PSPPEND(PSPCOUNT)=PPPPP,PSPCOUNT=PSPCOUNT+1
65 Q:'$O(PSPPEND(0))
66 W !!,?48,"PENDING ORDERS",!,LINE,!
67 F ZXXX=0:0 S ZXXX=$O(PSPPEND(ZXXX)) Q:'ZXXX S PZXZERO=$G(^PS(52.41,PSPPEND(ZXXX),0)) D:$P(PZXZERO,"^")
68 .S PZZDRUG=$P(PZXZERO,"^",9),PZZODRUG=$P(PZXZERO,"^",8)
69 .W !,"Drug: ",$S(PZZDRUG:$P($G(^PSDRUG(+PZZDRUG,0)),"^"),1:$P($G(^PS(50.7,+PZZODRUG,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"))
70 .W !?3,"Eff. Date: ",$E($P(PZXZERO,"^",6),4,5)_"/"_$E($P(PZXZERO,"^",6),6,7)_"/"_($E($P(PZXZERO,"^",6),1,3)+1700)
71 .W ?25,"Qty: ",$P(PZXZERO,"^",10),?50,"Refills: ",$P(PZXZERO,"^",11),?65,"Provider: ",$P($G(^VA(200,+$P(PZXZERO,"^",5),0)),"^")
72 .D FSIG^PSOUTLA("P",PSPPEND(ZXXX),100) W !?3,"Sig: ",$G(FSIG(1)) F FSIGZZ=1:0 S FSIGZZ=$O(FSIG(FSIGZZ)) Q:'FSIGZZ W !?8,$G(FSIG(FSIGZZ))
73 Q
74NVA ;displays non-va meds
75 Q:'$G(DFN)!('$O(^PS(55,DFN,"NVA",0)))
76 W !!?48,"Non-VA MEDS (Not dispensed by VA)",!,LINE
77 F NVA=0:0 S NVA=$O(^PS(55,DFN,"NVA",NVA)) Q:'NVA D
78 .S DUPRX0=^PS(55,DFN,"NVA",NVA,0) Q:'$P(DUPRX0,"^")
79 .W !!,"Orderable Item: "_$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_" Drug: "_$S($P(DUPRX0,"^",2):$P(^PSDRUG($P(DUPRX0,"^",2),0),"^"),1:"No Dispense Drug Selected")
80 .W !,"Status: "_$S($P(DUPRX0,"^",7):"Discontinued ("_$$FMTE^XLFDT($P($P(DUPRX0,"^",7),"."))_")",1:"Active")
81 .W !,"Drug Class: "_$S($P(DUPRX0,"^",2):$P(^PSDRUG($P(DUPRX0,"^",2),0),"^",2),1:"")
82 .W !,"Dosage: "_$P(DUPRX0,"^",3),!,"Schedule: "_$P(DUPRX0,"^",5),!,"Medication Route: "_$P(DUPRX0,"^",4)
83 .W !,"Start Date: "_$$FMTE^XLFDT($P(DUPRX0,"^",9)),?40,"CPRS Oder #: "_$P(DUPRX0,"^",8)
84 .W !,"Documented By: "_$P(^VA(200,$P(DUPRX0,"^",11),0),"^")_" on "_$$FMTE^XLFDT($P(DUPRX0,"^",10))
85 W ! K NVA,DUPRXO
86 Q
Note: See TracBrowser for help on using the repository browser.