80 lines
5.4 KiB
Mathematica
80 lines
5.4 KiB
Mathematica
PSOP2 ;BIR/SAB - medication profile long or short ;02/25/94
|
|
;;7.0;OUTPATIENT PHARMACY;**15,98,132**;DEC 1997
|
|
;External reference to File #55 supported by DBIA 2228
|
|
;External reference to PSDRUG supported by DBIA 221
|
|
;External reference ^PS(50.606 supported by DBIA 2174
|
|
;External reference ^PS(50.7 supported by DBIA 2223
|
|
DATE I $G(DTS) D Q:'$G(TRDT)
|
|
.S:$P(^PSRX(J,0),"^",13)'<SDT&($P(^(0),"^",13)'>EDT) TRDT=1
|
|
S X=$P(^PSRX(J,0),"^",13),X=999999999-X,^TMP($J,X,J)=^(0) K TRDT
|
|
Q
|
|
DRUG Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$P(^(0),"^")
|
|
I $G(DRS) D Q:'$G(TRDR)
|
|
.I DRG]PSFR,PSTO]DRG S TRDR=1
|
|
I $P($G(^PSRX(J,3)),"^",5),$P($G(^PSRX(J,3)),"^",5)<PSODTCT,$P($G(^("STA")),"^")>11,$P($G(^("STA")),"^")'=16 K TRDR Q
|
|
I $P($G(^PSRX(J,2)),"^",6)'<PSODTCT S ^TMP($J,$E(DRG,1,31),J)=^PSRX(J,0) K TRDR
|
|
Q
|
|
CLSS Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$P(^(0),"^",2)
|
|
I $G(CLS) D Q:'$G(TRCL)
|
|
.I DRG]PSFR,PSTO]DRG S TRCL=1
|
|
I $P($G(^PSRX(J,3)),"^",5),$P($G(^PSRX(J,3)),"^",5)<PSODTCT,$P($G(^("STA")),"^")>11,$P($G(^("STA")),"^")'=16 K TRCL Q
|
|
I $P($G(^PSRX(J,2)),"^",6)'<PSODTCT S ^TMP($J,$S(DRG]"":$E(DRG,1,31),1:"UNKNOWN"),J)=^PSRX(J,0) K TRCL
|
|
Q
|
|
PEND ;list pending orders
|
|
S PPPCNT=1 F PPP=0:0 S PPP=$O(^PS(52.41,"P",DFN,PPP)) Q:'PPP S PPPSTAT=$P($G(^PS(52.41,PPP,0)),"^",3) I PPPSTAT="NW"!(PPPSTAT="HD")!(PPPSTAT="RNW") D
|
|
.S PSOPEND(PPPCNT)=PPP_"^"_$S(+$P($G(^PS(52.41,PPP,0)),"^",9):"DD",1:"OI")_"^"_$P($G(^(0)),"^",5)_"^"_$P(^(0),"^",6)_"^"_$P(^(0),"^",10)_"^"_$P(^(0),"^",11) S PPPCNT=PPPCNT+1
|
|
Q:PPPCNT=1 I $E(IOST)="C" D DIR^PSOP1 Q:$G(PQT)
|
|
D HD1 S PPCOUNT=1 F EEEE=0:0 S EEEE=$O(PSOPEND(EEEE)) Q:'EEEE!($G(PQT)) D
|
|
.S PENDREX=$P(PSOPEND(EEEE),"^"),PPDIS=$P($G(^PS(52.41,PENDREX,0)),"^",9),PPOI=$P($G(^(0)),"^",8)
|
|
.W:PPCOUNT>1 ! W !,"Drug: ",$S($P(PSOPEND(EEEE),"^",2)="DD":$P($G(^PSDRUG(+PPDIS,0)),"^"),1:$P($G(^PS(50.7,+PPOI,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")),! S PPCOUNT=PPCOUNT+1
|
|
.W ?1,"Eff. Date: ",$E($P(PSOPEND(EEEE),"^",4),4,5)_"-"_$E($P(PSOPEND(EEEE),"^",4),6,7)_"-"_$E($P(PSOPEND(EEEE),"^",4),2,3),?22,"Qty: ",$P(PSOPEND(EEEE),"^",5),?40,"Refills: ",$P(PSOPEND(EEEE),"^",6)
|
|
.K DIC,X,Y S DIC="^VA(200,",DIC(0)="M",X="`"_+$P(PSOPEND(EEEE),"^",3) D ^DIC K DIC,X
|
|
.W ?52,"Prov: "_$E($P(Y,"^",2),1,21)
|
|
.D:($Y+5>IOSL)&($E(IOST)="C") DIR^PSOP1 Q:$G(PQT) D:$Y+5>IOSL HD1
|
|
.S PCOUNT=1 W !?1,"Sig: " F AAAA=0:0 S AAAA=$O(^PS(52.41,PENDREX,"SIG",AAAA)) Q:'AAAA!($G(PQT)) W:PCOUNT>1 ! W ?6,$G(^PS(52.41,PENDREX,"SIG",AAAA,0)) S PCOUNT=PCOUNT+1 D:($Y+5>IOSL)&($E(IOST)="C") DIR^PSOP1 Q:$G(PQT) D:$Y+5>IOSL
|
|
..D HD1 S PPCOUNT=$S('$O(^PS(52.41,PENDREX,"SIG",AAAA)):1,1:PPCOUNT)
|
|
I '$G(PQT),$E(IOST)="C" D DIR^PSOP1
|
|
Q
|
|
HD1 ;W @IOF W !,?29,"PENDING ORDERS",!,PSOPLINE
|
|
I $G(PLS)="L" S PAGE=PAGE+1
|
|
W @IOF W !,"Patient: "_$P($G(^DPT(DFN,0)),"^")_" ("_$E($P($G(^DPT(DFN,0)),"^",9),6,9)_")",?70,"Page: "_PAGE,!?21,$S($G(NVA):"Non-VA MEDS (Not Dispensed by VA)",1:"Pending Outpatient Orders"),!,PSOPLINE
|
|
I $G(PLS)="S" S PAGE=PAGE+1
|
|
Q
|
|
NVA ;non-va meds
|
|
Q:'$O(^PS(55,DFN,"NVA",0))
|
|
W !!,PSOPLINE,!?(80-$L("Non-VA MEDS (Not Dispensed by VA)"))/2,"Non-VA MEDS (Not Dispensed by VA)",!
|
|
K PQT S PCNT=1 F PPP=0:0 S PPP=$O(^PS(55,DFN,"NVA",PPP)) Q:'PPP!($G(PQT)) S NVAOR=^PS(55,DFN,"NVA",PPP,0),NVA=1 D
|
|
.;I PCNT D HD1 S PCNT=0
|
|
.Q:'$P(NVAOR,"^")
|
|
.I $Y+10>IOSL,$E(IOST)="C" D DIR^PSOP1 Q:$D(PQT) W @IOF
|
|
.I $Y+11>IOSL,$E(IOST)'="C" D HD1
|
|
.W !!,$S($P(NVAOR,"^",2):$P($G(^PSDRUG(+$P(NVAOR,"^",2),0)),"^"),1:$P($G(^PS(50.7,$P(NVAOR,"^"),0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"))
|
|
.I PLS="S" D Q
|
|
..W !?2,"Dosage: "_$P(NVAOR,"^",3)
|
|
..W !?2,"Schedule: "_$P(NVAOR,"^",5)
|
|
..W !?2,"Date Documented: "
|
|
..W $E($P(NVAOR,"^",10),4,5)_"/"_$E($P(NVAOR,"^",10),6,7)_"/"_$E($P(NVAOR,"^",10),2,3)
|
|
..W !?2,"Status: "_$S($P(NVAOR,"^",7):"Discontinued ("_$E($P(NVAOR,"^",7),4,5)_"/"_$E($P(NVAOR,"^",7),6,7)_"/"_$E($P(NVAOR,"^",7),2,3)_")",1:"Active")
|
|
.I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
|
|
.W !?2,"Dosage: "_$P(NVAOR,"^",3)
|
|
.W !?2,"Schedule: "_$P(NVAOR,"^",5)
|
|
.W !?2,"Route: "_$P(NVAOR,"^",4)
|
|
.W !?2,"Status: "_$S($P(NVAOR,"^",7):"Discontinued ("_$E($P(NVAOR,"^",7),4,5)_"/"_$E($P(NVAOR,"^",7),6,7)_"/"_$E($P(NVAOR,"^",7),2,3)_")",1:"Active")
|
|
.W !?2,"Start Date: "_$E($P(NVAOR,"^",9),4,5)_"/"_$E($P(NVAOR,"^",9),6,7)_"/"_$E($P(NVAOR,"^",9),2,3),?$X+5,"CPRS Order #: "_$P(NVAOR,"^",8)
|
|
.W !?2,"Documented By: "_$S($G(^VA(200,$P(NVAOR,"^",11),0))]"":$P(^VA(200,$P(NVAOR,"^",11),0),"^"),1:"Unknown")_" on "_$E($P(NVAOR,"^",10),4,5)_"/"_$E($P(NVAOR,"^",10),6,7)_"/"_$E($P(NVAOR,"^",10),2,3)
|
|
.I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
|
|
.I $O(^PS(55,DFN,"NVA",PPP,"OCK",0)) W !?2,"Order Check(s):" D
|
|
..I ($Y+5)>IOSL,$E(IOST)'="C" D HD1 W !?2,"Order Check(s):"
|
|
..F NVAP=0:0 S NVAP=$O(^PS(55,DFN,"NVA",PPP,"OCK",NVAP)) Q:'NVAP W !?3,"#"_NVAP_". "_$P(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,0),"^") S PRV=$P(^(0),"^",2) D I ($Y+5)>IOSL,$E(IOST)'="C" D HD1 W !?2,"Order Check(s):"
|
|
...I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
|
|
...I $O(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",0)) W !?5,"Override Reason: " D
|
|
....I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
|
|
....F NVAPR=0:0 S NVAPR=$O(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",NVAPR)) Q:'NVAPR W ?22,^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",NVAPR,0),!
|
|
..W ?2,"Override Provider: "_$P(^VA(200,PRV,0),"^"),!
|
|
.I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
|
|
.I $O(^PS(55,DFN,"NVA",PPP,"DSC",0)) W !?2,"Statement/Explanation/Comments: " D
|
|
..I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
|
|
..F NVAP=0:0 S NVAP=$O(^PS(55,DFN,"NVA",PPP,"DSC",NVAP)) Q:'NVAP W $P(^PS(55,DFN,"NVA",PPP,"DSC",NVAP,0),"^"),!?34
|
|
W ! K NVA,NVAP,NVAPR,NVAOR
|
|
Q
|