Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOP2

PSOP2.m

Go to the documentation of this file.
  1. PSOP2 ;BIR/SAB - medication profile long or short ;May 20, 2020@10:17
  1. ;;7.0;OUTPATIENT PHARMACY;**15,98,132,326,441**;DEC 1997;Build 208
  1. ;External reference to File #55 supported by DBIA 2228
  1. ;External reference to PSDRUG supported by DBIA 221
  1. ;External reference ^PS(50.606 supported by DBIA 2174
  1. ;External reference ^PS(50.7 supported by DBIA 2223
  1. DATE I $G(DTS) D Q:'$G(TRDT)
  1. .S:$P(^PSRX(J,0),"^",13)'<SDT&($P(^(0),"^",13)'>EDT) TRDT=1
  1. S X=$P(^PSRX(J,0),"^",13),X=999999999-X,^TMP($J,X,J)=^(0) K TRDT
  1. Q
  1. DRUG Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$P(^(0),"^")
  1. I $G(DRS) D Q:'$G(TRDR)
  1. .I DRG]PSFR,PSTO]DRG S TRDR=1
  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
  1. I $P($G(^PSRX(J,2)),"^",6)'<PSODTCT S ^TMP($J,$E(DRG,1,31),J)=^PSRX(J,0) K TRDR
  1. Q
  1. CLSS Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$P(^(0),"^",2)
  1. I $G(CLS) D Q:'$G(TRCL)
  1. .I DRG]PSFR,PSTO]DRG S TRCL=1
  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
  1. 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
  1. Q
  1. PEND ;list pending orders
  1. 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
  1. .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
  1. Q:PPPCNT=1 I $E(IOST)="C" D DIR^PSOP1 Q:$G(PQT)
  1. D HD1 S PPCOUNT=1 F EEEE=0:0 S EEEE=$O(PSOPEND(EEEE)) Q:'EEEE!($G(PQT)) D
  1. .S PENDREX=$P(PSOPEND(EEEE),"^"),PPDIS=$P($G(^PS(52.41,PENDREX,0)),"^",9),PPOI=$P($G(^(0)),"^",8)
  1. .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
  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)
  1. .K DIC,X,Y S DIC="^VA(200,",DIC(0)="M",X="`"_+$P(PSOPEND(EEEE),"^",3) D ^DIC K DIC,X
  1. .W ?52,"Prov: "_$E($P(Y,"^",2),1,21)
  1. .D:($Y+5>IOSL)&($E(IOST)="C") DIR^PSOP1 Q:$G(PQT) D:$Y+5>IOSL HD1
  1. .S PCOUNT=1 W !?1,"Sig: " N AAAA 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
  1. ..D HD1 S PPCOUNT=$S('$O(^PS(52.41,PENDREX,"SIG",AAAA)):1,1:PPCOUNT)
  1. .W:$P($G(^PS(52.41,PENDREX,4)),"^",2)]"" !,?1,"Indication: "_$P(^PS(52.41,PENDREX,4),"^",2) ;*441-IND
  1. I '$G(PQT),$E(IOST)="C" D DIR^PSOP1
  1. Q
  1. HD1 ;W @IOF W !,?29,"PENDING ORDERS",!,PSOPLINE
  1. I $G(PLS)="L" S PAGE=PAGE+1
  1. W @IOF W !,"Patient: "_$P($G(^DPT(DFN,0)),"^"),?70,"Page: "_PAGE,!?21,$S($G(NVA):"Non-VA MEDS (Not Dispensed by VA)",1:"Pending Outpatient Orders"),!,PSOPLINE
  1. I $G(PLS)="S" S PAGE=PAGE+1
  1. Q
  1. NVA ;non-va meds
  1. Q:'$O(^PS(55,DFN,"NVA",0))
  1. W !!,PSOPLINE,!?(80-$L("Non-VA MEDS (Not Dispensed by VA)"))/2,"Non-VA MEDS (Not Dispensed by VA)",!
  1. K PQT 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
  1. .Q:'$P(NVAOR,"^")
  1. .I $Y+10>IOSL,$E(IOST)="C" D DIR^PSOP1 Q:$D(PQT) W @IOF
  1. .I $Y+11>IOSL,$E(IOST)'="C" D HD1
  1. .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)),"^"))
  1. .I PLS="S" D Q
  1. ..W !?2,"Dosage: "_$P(NVAOR,"^",3)
  1. ..W !?2,"Schedule: "_$P(NVAOR,"^",5)
  1. ..W !?2,"Date Documented: "
  1. ..W $E($P(NVAOR,"^",10),4,5)_"/"_$E($P(NVAOR,"^",10),6,7)_"/"_$E($P(NVAOR,"^",10),2,3)
  1. ..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")
  1. ..W:$P($G(^PS(55,DFN,"NVA",PPP,2)),"^")]"" !,?2,"Indication: "_$P(^PS(55,DFN,"NVA",PPP,2),"^") ;*441-IND
  1. .I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
  1. .W !?2,"Dosage: "_$P(NVAOR,"^",3)
  1. .W !?2,"Schedule: "_$P(NVAOR,"^",5)
  1. .W !?2,"Route: "_$P(NVAOR,"^",4)
  1. .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")
  1. .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)
  1. .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)
  1. .W:$P($G(^PS(55,DFN,"NVA",PPP,2)),"^")]"" !,?2,"Indication: "_$P(^PS(55,DFN,"NVA",PPP,2),"^") ;*441-IND
  1. .I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
  1. .I $O(^PS(55,DFN,"NVA",PPP,"OCK",0)) W !?2,"Order Check(s):" D
  1. ..I ($Y+5)>IOSL,$E(IOST)'="C" D HD1 W !?2,"Order Check(s):"
  1. ..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):"
  1. ...I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
  1. ...I $O(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",0)) W !?5,"Override Reason: " D
  1. ....I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
  1. ....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),!
  1. ..W ?2,"Override Provider: "_$P(^VA(200,PRV,0),"^"),!
  1. .I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
  1. .I $O(^PS(55,DFN,"NVA",PPP,"DSC",0)) W !?2,"Statement/Explanation/Comments: " D
  1. ..I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
  1. ..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
  1. W ! K NVA,NVAP,NVAPR,NVAOR,PRV
  1. Q