source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOP2.m@ 1801

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

initial load of WorldVistAEHR
File size: 5.4 KB
Line 
1PSOP2 ;BIR/SAB - medication profile long or short ;02/25/94
2 ;;7.0;OUTPATIENT PHARMACY;**15,98,132**;DEC 1997
3 ;External reference to File #55 supported by DBIA 2228
4 ;External reference to PSDRUG supported by DBIA 221
5 ;External reference ^PS(50.606 supported by DBIA 2174
6 ;External reference ^PS(50.7 supported by DBIA 2223
7DATE I $G(DTS) D Q:'$G(TRDT)
8 .S:$P(^PSRX(J,0),"^",13)'<SDT&($P(^(0),"^",13)'>EDT) TRDT=1
9 S X=$P(^PSRX(J,0),"^",13),X=999999999-X,^TMP($J,X,J)=^(0) K TRDT
10 Q
11DRUG Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$P(^(0),"^")
12 I $G(DRS) D Q:'$G(TRDR)
13 .I DRG]PSFR,PSTO]DRG S TRDR=1
14 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
15 I $P($G(^PSRX(J,2)),"^",6)'<PSODTCT S ^TMP($J,$E(DRG,1,31),J)=^PSRX(J,0) K TRDR
16 Q
17CLSS Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$P(^(0),"^",2)
18 I $G(CLS) D Q:'$G(TRCL)
19 .I DRG]PSFR,PSTO]DRG S TRCL=1
20 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
21 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
22 Q
23PEND ;list pending orders
24 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
25 .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
26 Q:PPPCNT=1 I $E(IOST)="C" D DIR^PSOP1 Q:$G(PQT)
27 D HD1 S PPCOUNT=1 F EEEE=0:0 S EEEE=$O(PSOPEND(EEEE)) Q:'EEEE!($G(PQT)) D
28 .S PENDREX=$P(PSOPEND(EEEE),"^"),PPDIS=$P($G(^PS(52.41,PENDREX,0)),"^",9),PPOI=$P($G(^(0)),"^",8)
29 .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
30 .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)
31 .K DIC,X,Y S DIC="^VA(200,",DIC(0)="M",X="`"_+$P(PSOPEND(EEEE),"^",3) D ^DIC K DIC,X
32 .W ?52,"Prov: "_$E($P(Y,"^",2),1,21)
33 .D:($Y+5>IOSL)&($E(IOST)="C") DIR^PSOP1 Q:$G(PQT) D:$Y+5>IOSL HD1
34 .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
35 ..D HD1 S PPCOUNT=$S('$O(^PS(52.41,PENDREX,"SIG",AAAA)):1,1:PPCOUNT)
36 I '$G(PQT),$E(IOST)="C" D DIR^PSOP1
37 Q
38HD1 ;W @IOF W !,?29,"PENDING ORDERS",!,PSOPLINE
39 I $G(PLS)="L" S PAGE=PAGE+1
40 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
41 I $G(PLS)="S" S PAGE=PAGE+1
42 Q
43NVA ;non-va meds
44 Q:'$O(^PS(55,DFN,"NVA",0))
45 W !!,PSOPLINE,!?(80-$L("Non-VA MEDS (Not Dispensed by VA)"))/2,"Non-VA MEDS (Not Dispensed by VA)",!
46 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
47 .;I PCNT D HD1 S PCNT=0
48 .Q:'$P(NVAOR,"^")
49 .I $Y+10>IOSL,$E(IOST)="C" D DIR^PSOP1 Q:$D(PQT) W @IOF
50 .I $Y+11>IOSL,$E(IOST)'="C" D HD1
51 .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)),"^"))
52 .I PLS="S" D Q
53 ..W !?2,"Dosage: "_$P(NVAOR,"^",3)
54 ..W !?2,"Schedule: "_$P(NVAOR,"^",5)
55 ..W !?2,"Date Documented: "
56 ..W $E($P(NVAOR,"^",10),4,5)_"/"_$E($P(NVAOR,"^",10),6,7)_"/"_$E($P(NVAOR,"^",10),2,3)
57 ..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")
58 .I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
59 .W !?2,"Dosage: "_$P(NVAOR,"^",3)
60 .W !?2,"Schedule: "_$P(NVAOR,"^",5)
61 .W !?2,"Route: "_$P(NVAOR,"^",4)
62 .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")
63 .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)
64 .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)
65 .I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
66 .I $O(^PS(55,DFN,"NVA",PPP,"OCK",0)) W !?2,"Order Check(s):" D
67 ..I ($Y+5)>IOSL,$E(IOST)'="C" D HD1 W !?2,"Order Check(s):"
68 ..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):"
69 ...I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
70 ...I $O(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",0)) W !?5,"Override Reason: " D
71 ....I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
72 ....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),!
73 ..W ?2,"Override Provider: "_$P(^VA(200,PRV,0),"^"),!
74 .I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
75 .I $O(^PS(55,DFN,"NVA",PPP,"DSC",0)) W !?2,"Statement/Explanation/Comments: " D
76 ..I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
77 ..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
78 W ! K NVA,NVAP,NVAPR,NVAOR
79 Q
Note: See TracBrowser for help on using the repository browser.