source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOARCCV.m@ 632

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1PSOARCCV ;BHAM ISC/LGH - gather psrx info ; 08/19/92
2 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
3EN N X,XX,YX,DATE1,DATE2,DATE,%X,%Y
4 S RX0=+RX0,%X="^PSRX("_+RX0_",",%Y="RX("_+RX0_"," D %XY^%RCR
5 S $P(RX(RX0,3),"^",10)=$P("NON-","^",$S($D(^PS(55,$P(RX(RX0,0),"^",2),0)):$P(^(0),"^",2),1:0))_"SAFETY"
6 S $P(RX(RX0,0),"^",2)=$S($D(^DPT(+$P(RX(RX0,0),"^",2),0)):$P(^(0),"^"),1:"UNKNOWN"),$P(RX(RX0,0),"^",3)=$S($D(^PS(53,+$P(RX(RX0,0),"^",3),0)):$P(^(0),"^",2),1:"UNKNOWN")
7 S $P(RX(RX0,0),"^",15)=$P(^PSRX(RX0,"STA"),"^"),$P(RX(RX0,0),"^",10)=$P(^PSRX(RX0,"SIG"),"^")
8 S $P(RX(RX0,0),"^",4)=$S($D(^VA(200,+$P(RX(RX0,0),"^",4),0)):$P(^(0),"^"),1:"UNKNOWN"),$P(RX(RX0,0),"^",5)=$S($D(^SC(+$P(RX(RX0,0),"^",5),0)):$P(^(0),"^"),1:"UNKNOWN")
9 S $P(RX(RX0,0),"^",6)=$S($D(^PSDRUG(+$P(RX(RX0,0),"^",6),0)):$P(^(0),"^"),1:"UNKNOWN")
10 S $P(RX(RX0,2),"^",9)=$S($D(^PS(59,+$P(RX(RX0,2),"^",9),0)):$P(^(0),"^"),1:"UNKNOWN")
11 S $P(RX(RX0,0),"^",16)=$S($D(^VA(200,+$P(RX(RX0,0),"^",16),0)):$P(^(0),"^"),1:"UNKNOWN")
12 S X=$P(RX(RX0,0),"^",15)
13 S $P(RX(RX0,0),"^",15)=$S(X=1:"Non-Verified",X=2:"Refill",X=3:"Hold",X=4:"Non-Verified",X=5:"Suspended",X=11:"Expired",X=12:"Discontinued",X=13:"Deleted",X=14:"Discontinued",X=15:"Discontinued (Edit)",X=16:"Provider Hold",1:"Active")
14 I $P(RX(RX0,2),"^",6) S $P(RX(RX0,2),"^",11)=$P(RX(RX0,2),"^",6)
15 I $P(RX(RX0,0),"^",11)="M" S $P(RX(RX0,0),"^",11)="Mail"
16 E S $P(RX(RX0,0),"^",11)="Window"
17 I $P(RX(RX0,2),"^",3) S $P(RX(RX0,2),"^",3)=$S($D(^VA(200,+$P(RX(RX0,2),"^",3),0)):$P(^(0),"^"),1:"UNKNOWN")
18 I $P(RX(RX0,2),"^",10) S $P(RX(RX0,2),"^",10)=$S(+$D(^VA(200,+$P(RX(RX0,2),"^",10),0)):$P(^(0),"^"),1:"UNKNOWN",0:"")
19 I $P(RX(RX0,3),"^",3) S $P(RX(RX0,3),"^",3)=$S(+$D(^VA(200,+$P(RX(RX0,3),"^",3),0)):$P(^(0),"^"),1:"UNKNOWN",0:"")
20 I $O(RX(RX0,1,0)) S XTYPE=1 F X=0:0 S X=$O(RX(RX0,1,X)) Q:'X S XY=X D:$G(RX(RX0,XTYPE,X,0))]"" REFILL,DATE
21 S $P(RX(RX0,3),"^",11)=+$P(RX(RX0,0),"^",9)-(+$G(XY))
22L I +$P($G(RX(RX0,"L",0)),"^",2) S XTYPE="L" F X=0:0 S X=$O(RX(RX0,"L",X)) Q:+X'>0 D LABEL,DATE
23A I +$P($G(RX(RX0,"A",0)),"^",2) S XTYPE="A" F X=0:0 S X=$O(RX(RX0,"A",X)) Q:+X'>0 D AUDIT,DATE
24P I $O(^PSRX(RX0,"P",0)) S XTYPE="P" F X=0:0 S X=$O(^PSRX(RX0,"P",X)) Q:'X D:$G(^PSRX(RX0,XTYPE,X,0))]"" REFILL,DATE
25 I +$G(RX(RX0,"IB")) S RX(RX0,"IB")=$S($D(^IBE(350.1,+$P(RX(RX0,"IB"),"^"),0)):$P(^(0),"^"),1:"UNKNOWN")
26 I $G(RX(RX0,"TN"))]"" S $P(RX(RX0,3),"^",12)=$G(RX(RX0,"TN"))
27CMOP I $O(RX(RX0,4,0)) F ZX=0:0 S ZX=$O(RX(RX0,4,ZX)) Q:'ZX D
28 .S ZST=+$P($G(RX(RX0,4,ZX,0)),"^",4) I $G(ZST)]"" S $P(RX(RX0,4,ZX,0),"^",4)=$S(ZST=0:"TRANS",ZST=1:"DISP",ZST=2:"RETRANS",ZST=3:"NOT DISP",1:"UNKNOWN")
29 .S Y=+$P($G(RX(RX0,4,ZX,0)),"^",5) I Y D DATECV S $P(RX(RX0,4,ZX,0),"^",5)="CANCEL DATE/REASON "_$P(Y,"@")_" "_$P($G(RX(RX0,4,ZX,1)),"^")
30 .I $P(RX(RX0,4,ZX,0),"^",8)]"" S $P(RX(RX0,4,ZX,0),"^",8)="NDC: "_$P(RX(RX0,4,ZX,0),"^",8)
31 .I $P($G(RX(RX0,4,ZX,1)),"^",2)]"" S Y=$P(RX(RX0,4,ZX,1),"^",2) X ^DD("DD") S $P(RX(RX0,4,ZX,0),"^",9)=$P(Y,"@")
32 .S $P(RX(RX0,4,ZX,0),"^",10)=$P($G(RX(RX0,4,ZX,1)),"^",3)
33 .S $P(RX(RX0,4,ZX,0),"^",11)=$P($G(RX(RX0,4,ZX,1)),"^",4)
34 I $O(RX(RX0,5,0)) F ZX=0:0 S ZX=$O(RX(RX0,5,ZX)) Q:'ZX D
35 .S Y=+$P($G(RX(RX0,5,ZX,0)),"^",2) I Y D DATECV S $P(RX(RX0,5,ZX,0),"^",2)=$P(Y,"@",1)
36CVDATES ;
37 S Y=+$P(RX(RX0,0),"^",13) I Y D DATECV S $P(RX(RX0,0),"^",13)=$P(Y,"@",1)
38 S Y=+$P(RX(RX0,2),"^") I Y D DATECV S $P(RX(RX0,2),"^")=$P(Y,"@",1)
39 S Y=+$P(RX(RX0,2),"^",2) I Y D DATECV S $P(RX(RX0,2),"^",2)=$P(Y,"@",1)
40 S Y=+$P(RX(RX0,2),"^",5) I Y D DATECV S $P(RX(RX0,2),"^",5)=$P(Y,"@",1)
41 S Y=+$P(RX(RX0,2),"^",6) I Y D DATECV S $P(RX(RX0,2),"^",6)=$P(Y,"@",1)
42 S Y=+$P(RX(RX0,2),"^",11) I Y D DATECV S $P(RX(RX0,2),"^",11)=$P(Y,"@",1)
43 S Y=+$P(RX(RX0,2),"^",13) I Y D DATECV S $P(RX(RX0,2),"^",13)=$P(Y,"@",1)
44 S Y=+$P(RX(RX0,3),"^") I Y D DATECV S $P(RX(RX0,3),"^")=$P(Y,"@",1)
45 S Y=+$P(RX(RX0,3),"^",2) I Y D DATECV S $P(RX(RX0,3),"^",2)=$P(Y,"@",1)
46 K X,XX,YX,DATE1,DATE2,DATE,%X,%Y,Y,XY,XTYPE
47 Q
48DATE ;
49 Q:'$D(RX(RX0,XTYPE,X,0))
50 S Y=+$P($G(RX(RX0,XTYPE,X,0)),"^") I Y D DATECV S $P(RX(RX0,XTYPE,X,0),"^")=$P(Y,"@",1)
51 I XTYPE=1 S Y=+$P($G(RX(RX0,XTYPE,X,0)),"^",15) I Y D DATECV S $P(RX(RX0,XTYPE,X,0),"^",15)=$P(Y,"@",1)
52 I XTYPE=1 S Y=+$P($G(RX(RX0,XTYPE,X,0)),"^",19) I Y D DATECV S $P(RX(RX0,XTYPE,X,0),"^",19)=$P(Y,"@",1)
53 I XTYPE=1 S Y=+$P(RX(RX0,XTYPE,X,0),"^",18) I Y D DATECV S $P(RX(RX0,XTYPE,X,0),"^",18)=$P(Y,"@",1)
54 Q
55 ;
56REFILL S $P(RX(RX0,XTYPE,X,0),"^",5)=$S($D(^VA(200,+$P(RX(RX0,XTYPE,X,0),"^",5),0)):$P(^(0),"^"),1:"UNKNOWN")
57 S $P(RX(RX0,XTYPE,X,0),"^",7)=$S($D(^VA(200,+$P(RX(RX0,XTYPE,X,0),"^",7),0)):$P(^(0),"^"),1:"UNKNOWN")
58 S $P(RX(RX0,XTYPE,X,0),"^",9)=$S($D(^PS(59,+$P(RX(RX0,XTYPE,X,0),"^",9),0)):$P(^(0),"^"),1:"UNKNOWN")
59 I $P(RX(RX0,XTYPE,X,0),"^",17) S $P(RX(RX0,XTYPE,X,0),"^",17)=$S($D(^VA(200,+$P(RX(RX0,XTYPE,X,0),"^",17),0)):$P(^(0),"^"),1:"UNKNOWN")
60 I $D(RX(RX0,XTYPE,X,"IB")) S $P(RX(RX0,XTYPE,X,0),"^",20)=RX(RX0,XTYPE,X,"IB")
61 Q
62AUDIT S $P(RX(RX0,"A",X,0),"^",3)=$S($D(^VA(200,+$P(RX(RX0,"A",X,0),"^",3),0)):$P(^(0),"^"),1:"UNKNOWN")
63 S YX=$O(RX(RX0,"A",X)) Q:+YX'>0 S DATE=$P(RX(RX0,"A",YX,0),".",1)
64 I $P(RX(RX0,"A",X,0),".",1)=DATE,$P(RX(RX0,"A",X,0),"^",2)["W",$P(RX(RX0,"A",YX,0),"^",2)["W" K RX(RX0,"A",X,0)
65 Q
66LABEL S $P(RX(RX0,"L",X,0),"^",4)=$S($D(^VA(200,+$P(RX(RX0,"L",X,0),"^",4),0)):$P(^(0),"^"),1:"UNKNOWN")
67 S YX=$O(RX(RX0,"L",X)) Q:+YX'>0 S DATE2=$E($P(RX(RX0,"L",YX,0),"^"),1,10),DATE1=$E($P(RX(RX0,"L",X,0),"^"),1,10)
68 Q
69DATECV ;converts internal dates to ext dates
70 X ^DD("DD") Q
Note: See TracBrowser for help on using the repository browser.