71 lines
5.4 KiB
Mathematica
71 lines
5.4 KiB
Mathematica
PSOARCCV ;BHAM ISC/LGH - gather psrx info ; 08/19/92
|
|
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
|
|
EN N X,XX,YX,DATE1,DATE2,DATE,%X,%Y
|
|
S RX0=+RX0,%X="^PSRX("_+RX0_",",%Y="RX("_+RX0_"," D %XY^%RCR
|
|
S $P(RX(RX0,3),"^",10)=$P("NON-","^",$S($D(^PS(55,$P(RX(RX0,0),"^",2),0)):$P(^(0),"^",2),1:0))_"SAFETY"
|
|
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")
|
|
S $P(RX(RX0,0),"^",15)=$P(^PSRX(RX0,"STA"),"^"),$P(RX(RX0,0),"^",10)=$P(^PSRX(RX0,"SIG"),"^")
|
|
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")
|
|
S $P(RX(RX0,0),"^",6)=$S($D(^PSDRUG(+$P(RX(RX0,0),"^",6),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|
S $P(RX(RX0,2),"^",9)=$S($D(^PS(59,+$P(RX(RX0,2),"^",9),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|
S $P(RX(RX0,0),"^",16)=$S($D(^VA(200,+$P(RX(RX0,0),"^",16),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|
S X=$P(RX(RX0,0),"^",15)
|
|
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")
|
|
I $P(RX(RX0,2),"^",6) S $P(RX(RX0,2),"^",11)=$P(RX(RX0,2),"^",6)
|
|
I $P(RX(RX0,0),"^",11)="M" S $P(RX(RX0,0),"^",11)="Mail"
|
|
E S $P(RX(RX0,0),"^",11)="Window"
|
|
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")
|
|
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:"")
|
|
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:"")
|
|
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
|
|
S $P(RX(RX0,3),"^",11)=+$P(RX(RX0,0),"^",9)-(+$G(XY))
|
|
L 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
|
|
A 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
|
|
P 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
|
|
I +$G(RX(RX0,"IB")) S RX(RX0,"IB")=$S($D(^IBE(350.1,+$P(RX(RX0,"IB"),"^"),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|
I $G(RX(RX0,"TN"))]"" S $P(RX(RX0,3),"^",12)=$G(RX(RX0,"TN"))
|
|
CMOP I $O(RX(RX0,4,0)) F ZX=0:0 S ZX=$O(RX(RX0,4,ZX)) Q:'ZX D
|
|
.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")
|
|
.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)),"^")
|
|
.I $P(RX(RX0,4,ZX,0),"^",8)]"" S $P(RX(RX0,4,ZX,0),"^",8)="NDC: "_$P(RX(RX0,4,ZX,0),"^",8)
|
|
.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,"@")
|
|
.S $P(RX(RX0,4,ZX,0),"^",10)=$P($G(RX(RX0,4,ZX,1)),"^",3)
|
|
.S $P(RX(RX0,4,ZX,0),"^",11)=$P($G(RX(RX0,4,ZX,1)),"^",4)
|
|
I $O(RX(RX0,5,0)) F ZX=0:0 S ZX=$O(RX(RX0,5,ZX)) Q:'ZX D
|
|
.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)
|
|
CVDATES ;
|
|
S Y=+$P(RX(RX0,0),"^",13) I Y D DATECV S $P(RX(RX0,0),"^",13)=$P(Y,"@",1)
|
|
S Y=+$P(RX(RX0,2),"^") I Y D DATECV S $P(RX(RX0,2),"^")=$P(Y,"@",1)
|
|
S Y=+$P(RX(RX0,2),"^",2) I Y D DATECV S $P(RX(RX0,2),"^",2)=$P(Y,"@",1)
|
|
S Y=+$P(RX(RX0,2),"^",5) I Y D DATECV S $P(RX(RX0,2),"^",5)=$P(Y,"@",1)
|
|
S Y=+$P(RX(RX0,2),"^",6) I Y D DATECV S $P(RX(RX0,2),"^",6)=$P(Y,"@",1)
|
|
S Y=+$P(RX(RX0,2),"^",11) I Y D DATECV S $P(RX(RX0,2),"^",11)=$P(Y,"@",1)
|
|
S Y=+$P(RX(RX0,2),"^",13) I Y D DATECV S $P(RX(RX0,2),"^",13)=$P(Y,"@",1)
|
|
S Y=+$P(RX(RX0,3),"^") I Y D DATECV S $P(RX(RX0,3),"^")=$P(Y,"@",1)
|
|
S Y=+$P(RX(RX0,3),"^",2) I Y D DATECV S $P(RX(RX0,3),"^",2)=$P(Y,"@",1)
|
|
K X,XX,YX,DATE1,DATE2,DATE,%X,%Y,Y,XY,XTYPE
|
|
Q
|
|
DATE ;
|
|
Q:'$D(RX(RX0,XTYPE,X,0))
|
|
S Y=+$P($G(RX(RX0,XTYPE,X,0)),"^") I Y D DATECV S $P(RX(RX0,XTYPE,X,0),"^")=$P(Y,"@",1)
|
|
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)
|
|
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)
|
|
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)
|
|
Q
|
|
;
|
|
REFILL S $P(RX(RX0,XTYPE,X,0),"^",5)=$S($D(^VA(200,+$P(RX(RX0,XTYPE,X,0),"^",5),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|
S $P(RX(RX0,XTYPE,X,0),"^",7)=$S($D(^VA(200,+$P(RX(RX0,XTYPE,X,0),"^",7),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|
S $P(RX(RX0,XTYPE,X,0),"^",9)=$S($D(^PS(59,+$P(RX(RX0,XTYPE,X,0),"^",9),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|
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")
|
|
I $D(RX(RX0,XTYPE,X,"IB")) S $P(RX(RX0,XTYPE,X,0),"^",20)=RX(RX0,XTYPE,X,"IB")
|
|
Q
|
|
AUDIT S $P(RX(RX0,"A",X,0),"^",3)=$S($D(^VA(200,+$P(RX(RX0,"A",X,0),"^",3),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|
S YX=$O(RX(RX0,"A",X)) Q:+YX'>0 S DATE=$P(RX(RX0,"A",YX,0),".",1)
|
|
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)
|
|
Q
|
|
LABEL S $P(RX(RX0,"L",X,0),"^",4)=$S($D(^VA(200,+$P(RX(RX0,"L",X,0),"^",4),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|
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)
|
|
Q
|
|
DATECV ;converts internal dates to ext dates
|
|
X ^DD("DD") Q
|