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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOARCCV 5562 printed Sep 23, 2025@20:00:23 Page 2
PSOARCCV ;BHAM ISC/LGH - gather psrx info ; 08/19/92
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
EN NEW X,XX,YX,DATE1,DATE2,DATE,%X,%Y
+1 SET RX0=+RX0
SET %X="^PSRX("_+RX0_","
SET %Y="RX("_+RX0_","
DO %XY^%RCR
+2 SET $PIECE(RX(RX0,3),"^",10)=$PIECE("NON-","^",$SELECT($DATA(^PS(55,$PIECE(RX(RX0,0),"^",2),0)):$PIECE(^(0),"^",2),1:0))_"SAFETY"
+3 SET $PIECE(RX(RX0,0),"^",2)=$SELECT($DATA(^DPT(+$PIECE(RX(RX0,0),"^",2),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
SET $PIECE(RX(RX0,0),"^",3)=$SELECT($DATA(^PS(53,+$PIECE(RX(RX0,0),"^",3),0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
+4 SET $PIECE(RX(RX0,0),"^",15)=$PIECE(^PSRX(RX0,"STA"),"^")
SET $PIECE(RX(RX0,0),"^",10)=$PIECE(^PSRX(RX0,"SIG"),"^")
+5 SET $PIECE(RX(RX0,0),"^",4)=$SELECT($DATA(^VA(200,+$PIECE(RX(RX0,0),"^",4),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
SET $PIECE(RX(RX0,0),"^",5)=$SELECT($DATA(^SC(+$PIECE(RX(RX0,0),"^",5),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+6 SET $PIECE(RX(RX0,0),"^",6)=$SELECT($DATA(^PSDRUG(+$PIECE(RX(RX0,0),"^",6),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+7 SET $PIECE(RX(RX0,2),"^",9)=$SELECT($DATA(^PS(59,+$PIECE(RX(RX0,2),"^",9),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+8 SET $PIECE(RX(RX0,0),"^",16)=$SELECT($DATA(^VA(200,+$PIECE(RX(RX0,0),"^",16),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+9 SET X=$PIECE(RX(RX0,0),"^",15)
+10 SET $PIECE(RX(RX0,0),"^",15)=$SELECT(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")
+11 IF $PIECE(RX(RX0,2),"^",6)
SET $PIECE(RX(RX0,2),"^",11)=$PIECE(RX(RX0,2),"^",6)
+12 IF $PIECE(RX(RX0,0),"^",11)="M"
SET $PIECE(RX(RX0,0),"^",11)="Mail"
+13 IF '$TEST
SET $PIECE(RX(RX0,0),"^",11)="Window"
+14 IF $PIECE(RX(RX0,2),"^",3)
SET $PIECE(RX(RX0,2),"^",3)=$SELECT($DATA(^VA(200,+$PIECE(RX(RX0,2),"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+15 IF $PIECE(RX(RX0,2),"^",10)
SET $PIECE(RX(RX0,2),"^",10)=$SELECT(+$DATA(^VA(200,+$PIECE(RX(RX0,2),"^",10),0)):$PIECE(^(0),"^"),1:"UNKNOWN",0:"")
+16 IF $PIECE(RX(RX0,3),"^",3)
SET $PIECE(RX(RX0,3),"^",3)=$SELECT(+$DATA(^VA(200,+$PIECE(RX(RX0,3),"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN",0:"")
+17 IF $ORDER(RX(RX0,1,0))
SET XTYPE=1
FOR X=0:0
SET X=$ORDER(RX(RX0,1,X))
if 'X
QUIT
SET XY=X
if $GET(RX(RX0,XTYPE,X,0))]""
DO REFILL
DO DATE
+18 SET $PIECE(RX(RX0,3),"^",11)=+$PIECE(RX(RX0,0),"^",9)-(+$GET(XY))
L IF +$PIECE($GET(RX(RX0,"L",0)),"^",2)
SET XTYPE="L"
FOR X=0:0
SET X=$ORDER(RX(RX0,"L",X))
if +X'>0
QUIT
DO LABEL
DO DATE
A IF +$PIECE($GET(RX(RX0,"A",0)),"^",2)
SET XTYPE="A"
FOR X=0:0
SET X=$ORDER(RX(RX0,"A",X))
if +X'>0
QUIT
DO AUDIT
DO DATE
P IF $ORDER(^PSRX(RX0,"P",0))
SET XTYPE="P"
FOR X=0:0
SET X=$ORDER(^PSRX(RX0,"P",X))
if 'X
QUIT
if $GET(^PSRX(RX0,XTYPE,X,0))]""
DO REFILL
DO DATE
+1 IF +$GET(RX(RX0,"IB"))
SET RX(RX0,"IB")=$SELECT($DATA(^IBE(350.1,+$PIECE(RX(RX0,"IB"),"^"),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+2 IF $GET(RX(RX0,"TN"))]""
SET $PIECE(RX(RX0,3),"^",12)=$GET(RX(RX0,"TN"))
CMOP IF $ORDER(RX(RX0,4,0))
FOR ZX=0:0
SET ZX=$ORDER(RX(RX0,4,ZX))
if 'ZX
QUIT
Begin DoDot:1
+1 SET ZST=+$PIECE($GET(RX(RX0,4,ZX,0)),"^",4)
IF $GET(ZST)]""
SET $PIECE(RX(RX0,4,ZX,0),"^",4)=$SELECT(ZST=0:"TRANS",ZST=1:"DISP",ZST=2:"RETRANS",ZST=3:"NOT DISP",1:"UNKNOWN")
+2 SET Y=+$PIECE($GET(RX(RX0,4,ZX,0)),"^",5)
IF Y
DO DATECV
SET $PIECE(RX(RX0,4,ZX,0),"^",5)="CANCEL DATE/REASON "_$PIECE(Y,"@")_" "_$PIECE($GET(RX(RX0,4,ZX,1)),"^")
+3 IF $PIECE(RX(RX0,4,ZX,0),"^",8)]""
SET $PIECE(RX(RX0,4,ZX,0),"^",8)="NDC: "_$PIECE(RX(RX0,4,ZX,0),"^",8)
+4 IF $PIECE($GET(RX(RX0,4,ZX,1)),"^",2)]""
SET Y=$PIECE(RX(RX0,4,ZX,1),"^",2)
XECUTE ^DD("DD")
SET $PIECE(RX(RX0,4,ZX,0),"^",9)=$PIECE(Y,"@")
+5 SET $PIECE(RX(RX0,4,ZX,0),"^",10)=$PIECE($GET(RX(RX0,4,ZX,1)),"^",3)
+6 SET $PIECE(RX(RX0,4,ZX,0),"^",11)=$PIECE($GET(RX(RX0,4,ZX,1)),"^",4)
End DoDot:1
+7 IF $ORDER(RX(RX0,5,0))
FOR ZX=0:0
SET ZX=$ORDER(RX(RX0,5,ZX))
if 'ZX
QUIT
Begin DoDot:1
+8 SET Y=+$PIECE($GET(RX(RX0,5,ZX,0)),"^",2)
IF Y
DO DATECV
SET $PIECE(RX(RX0,5,ZX,0),"^",2)=$PIECE(Y,"@",1)
End DoDot:1
CVDATES ;
+1 SET Y=+$PIECE(RX(RX0,0),"^",13)
IF Y
DO DATECV
SET $PIECE(RX(RX0,0),"^",13)=$PIECE(Y,"@",1)
+2 SET Y=+$PIECE(RX(RX0,2),"^")
IF Y
DO DATECV
SET $PIECE(RX(RX0,2),"^")=$PIECE(Y,"@",1)
+3 SET Y=+$PIECE(RX(RX0,2),"^",2)
IF Y
DO DATECV
SET $PIECE(RX(RX0,2),"^",2)=$PIECE(Y,"@",1)
+4 SET Y=+$PIECE(RX(RX0,2),"^",5)
IF Y
DO DATECV
SET $PIECE(RX(RX0,2),"^",5)=$PIECE(Y,"@",1)
+5 SET Y=+$PIECE(RX(RX0,2),"^",6)
IF Y
DO DATECV
SET $PIECE(RX(RX0,2),"^",6)=$PIECE(Y,"@",1)
+6 SET Y=+$PIECE(RX(RX0,2),"^",11)
IF Y
DO DATECV
SET $PIECE(RX(RX0,2),"^",11)=$PIECE(Y,"@",1)
+7 SET Y=+$PIECE(RX(RX0,2),"^",13)
IF Y
DO DATECV
SET $PIECE(RX(RX0,2),"^",13)=$PIECE(Y,"@",1)
+8 SET Y=+$PIECE(RX(RX0,3),"^")
IF Y
DO DATECV
SET $PIECE(RX(RX0,3),"^")=$PIECE(Y,"@",1)
+9 SET Y=+$PIECE(RX(RX0,3),"^",2)
IF Y
DO DATECV
SET $PIECE(RX(RX0,3),"^",2)=$PIECE(Y,"@",1)
+10 KILL X,XX,YX,DATE1,DATE2,DATE,%X,%Y,Y,XY,XTYPE
+11 QUIT
DATE ;
+1 if '$DATA(RX(RX0,XTYPE,X,0))
QUIT
+2 SET Y=+$PIECE($GET(RX(RX0,XTYPE,X,0)),"^")
IF Y
DO DATECV
SET $PIECE(RX(RX0,XTYPE,X,0),"^")=$PIECE(Y,"@",1)
+3 IF XTYPE=1
SET Y=+$PIECE($GET(RX(RX0,XTYPE,X,0)),"^",15)
IF Y
DO DATECV
SET $PIECE(RX(RX0,XTYPE,X,0),"^",15)=$PIECE(Y,"@",1)
+4 IF XTYPE=1
SET Y=+$PIECE($GET(RX(RX0,XTYPE,X,0)),"^",19)
IF Y
DO DATECV
SET $PIECE(RX(RX0,XTYPE,X,0),"^",19)=$PIECE(Y,"@",1)
+5 IF XTYPE=1
SET Y=+$PIECE(RX(RX0,XTYPE,X,0),"^",18)
IF Y
DO DATECV
SET $PIECE(RX(RX0,XTYPE,X,0),"^",18)=$PIECE(Y,"@",1)
+6 QUIT
+7 ;
REFILL SET $PIECE(RX(RX0,XTYPE,X,0),"^",5)=$SELECT($DATA(^VA(200,+$PIECE(RX(RX0,XTYPE,X,0),"^",5),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+1 SET $PIECE(RX(RX0,XTYPE,X,0),"^",7)=$SELECT($DATA(^VA(200,+$PIECE(RX(RX0,XTYPE,X,0),"^",7),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+2 SET $PIECE(RX(RX0,XTYPE,X,0),"^",9)=$SELECT($DATA(^PS(59,+$PIECE(RX(RX0,XTYPE,X,0),"^",9),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+3 IF $PIECE(RX(RX0,XTYPE,X,0),"^",17)
SET $PIECE(RX(RX0,XTYPE,X,0),"^",17)=$SELECT($DATA(^VA(200,+$PIECE(RX(RX0,XTYPE,X,0),"^",17),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+4 IF $DATA(RX(RX0,XTYPE,X,"IB"))
SET $PIECE(RX(RX0,XTYPE,X,0),"^",20)=RX(RX0,XTYPE,X,"IB")
+5 QUIT
AUDIT SET $PIECE(RX(RX0,"A",X,0),"^",3)=$SELECT($DATA(^VA(200,+$PIECE(RX(RX0,"A",X,0),"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+1 SET YX=$ORDER(RX(RX0,"A",X))
if +YX'>0
QUIT
SET DATE=$PIECE(RX(RX0,"A",YX,0),".",1)
+2 IF $PIECE(RX(RX0,"A",X,0),".",1)=DATE
IF $PIECE(RX(RX0,"A",X,0),"^",2)["W"
IF $PIECE(RX(RX0,"A",YX,0),"^",2)["W"
KILL RX(RX0,"A",X,0)
+3 QUIT
LABEL SET $PIECE(RX(RX0,"L",X,0),"^",4)=$SELECT($DATA(^VA(200,+$PIECE(RX(RX0,"L",X,0),"^",4),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+1 SET YX=$ORDER(RX(RX0,"L",X))
if +YX'>0
QUIT
SET DATE2=$EXTRACT($PIECE(RX(RX0,"L",YX,0),"^"),1,10)
SET DATE1=$EXTRACT($PIECE(RX(RX0,"L",X,0),"^"),1,10)
+2 QUIT
DATECV ;converts internal dates to ext dates
+1 XECUTE ^DD("DD")
QUIT
