47 lines
2.6 KiB
Mathematica
47 lines
2.6 KiB
Mathematica
PSOARCTG ;BHAM ISC/LGH - gather tape info ; 07/07/92
|
|
;;7.0;OUTPATIENT PHARMACY;**10**;DEC 1997
|
|
AC S DFN=DA,TA=$S($D(PSOAT):1,1:0) K T D ADD^VADPT,DEM^VADPT,ELIG^VADPT
|
|
S I=$P($G(VADM(3)),"^")
|
|
S T(1)=$G(VADM(1))_"^"_$P($G(VADM(2)),"^")_"^"_$P($G(VAEL(1)),"^",2)
|
|
S T(1)=T(1)_"^"_$G(VAPA(1))_"^"_$S(I:$E(I,4,5)_"-"_$E(I,6,7)_"-"_(1700+$E(I,1,3)),1:"UNKNOWN")_"^"_$S($G(VAPA(8)):VAPA(8),1:"")
|
|
S T(1)=T(1)_"^"_$G(VAPA(4))_"^"_$P($G(VAPA(5)),"^",2)_"^"_$G(VAPA(6))_"^"
|
|
I $D(^PS(55,DFN,0)),+$P(^(0),"^",2) S T(1)=T(1)_1_"^" S:+$P(^(0),"^",4) T(1)=T(1)_1
|
|
S T(2)="" I $D(^PS(55,DFN,1)),^(1)]"" S T(2)=T(2)_^(1)
|
|
S T(2)=T(2)_"^^^^",PSLC=0 G MA:'$D(^DPT(DFN,.17)) G MA:$P(^(.17),"^",2)'="I" S TZ=1 G MA:'$D(^DPT(DFN,.372))
|
|
F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:+I'>0 S I1=$S($D(^(I,0)):^(0),1:""),PSDIS=$S($D(^DIC(31,+I1,0)):^(0),1:""),PSPRCNT=$P(I1,"^",2),T(2,TZ)=PSDIS_"^"_PSPRCNT,TZ=TZ+1
|
|
S T(2)=$P(T(2),"^")_"^"_(TZ-1)_"^"_$P(T(2),"^",3,99)
|
|
MA S GMRA="0^0^111" D ^GMRADPT
|
|
G END:'$G(GMRAL) S TZ=1 F I1=0:0 S I1=$O(GMRAL(I1)) Q:'I1 S T(3,TZ)=$P($G(GMRAL(I1)),"^",2),TZ=TZ+1
|
|
S T(2)=$P(T(2),"^",1,2)_"^"_(TZ-1)_"^"_$P(T(2),"^",4,99)
|
|
END D KVA^VADPT K GMRAL,TZ,SC
|
|
Q Q
|
|
CMOP ;Called by ACT+1^PSOARX Prints CMOP Data for "Display Archived Rx's"
|
|
F Z1=0:0 S Z1=$O(^PSRX(DA,4,Z1)) Q:(+$G(Z1)<1) S ZZ1=^(Z1,0) D
|
|
.I $Y'>(PSOACPL-20),(Z1=1) D C1
|
|
.D:$Y>(PSOACPL-20) HD1,C1
|
|
.S Y=$P($G(ZZ1),"^",5) I Y X ^DD("DD") S $P(ZZ1,"^",5)=$P(Y,"@") K Y
|
|
.S ZST=+$P($G(ZZ1),"^",4) I $G(ZST)]"" S $P(ZZ1,"^",4)=$S(ZST=0:"TRANS",ZST=1:"DISP",ZST=2:"RETRANS",ZST=3:"NOT DISP",1:"UNKNOWN")
|
|
.W !,Z1,?3,$P(ZZ1,"^")_"-"_$P(ZZ1,"^",2)
|
|
.W ?22,$J($P(ZZ1,"^",3),3),?30,$P(ZZ1,"^",4)
|
|
.S ZZ2=$G(^PSRX(DA,4,Z1,1)) I $G(ZZ2)]"" D
|
|
..S Y=$P(ZZ2,"^",2) I $G(Y)]"" X ^DD("DD") S $P(ZZ2,"^",2)=$P(Y,"@") K Y
|
|
..W ?40,$P(ZZ2,"^",2),?52,$E($P(ZZ2,"^",3),1,20),?74,$E($P(ZZ2,"^",4),1,20) K ZZ2
|
|
.W ?96,$S($P(ZZ1,"^",8)]"":"NDC "_$P(ZZ1,"^",8),$P(ZZ1,"^",5)]"":"CAN DT/REASON "_$P(ZZ1,"^",5)_" "_$E($G(^PSRX(DA,4,Z1,1)),1,20),1:"")
|
|
K ZZ1,Z1,ZST,ZZ2
|
|
F Z1=0:0 S Z1=$O(^PSRX(DA,5,Z1)) Q:'Z1 S ZZ1=^(Z1,0) D
|
|
.I $Y'>(PSOACPL-20),(Z1=1) D C2
|
|
.D:$Y>(PSOACPL-20) HD1,C2
|
|
.S Y=$P($G(ZZ1),"^",2) I Y X ^DD("DD") S $P(ZZ1,"^",2)=Y
|
|
.W !,Z1,?5,$P(ZZ1,"^"),?51,$J($P(ZZ1,"^",2),12),?71,$J($P(ZZ1,"^",3),3)
|
|
K Z1,ZZ1,ZST
|
|
Q
|
|
C1 W !!,"CMOP EVENT LOG"
|
|
W !,"#",?5,"TRANS #",?20,"RX REF",?30,"STATUS",?40,"SHIP DATE",?52,"CARRIER",?76,"PACKAGE ID",?100,"REMARKS"
|
|
W ! F I=1:1:120 W "="
|
|
Q
|
|
C2 W !!,"CMOP LOT#/EXPIRATION DATE LOG"
|
|
W !,"#",?15,"LOT #",?49,"EXPIRATION DATE",?70,"RX REF"
|
|
W ! F I=1:1:80 W "="
|
|
Q
|
|
HD1 W @PSOACPF,?(66-($L(PSOACDS)\2)),PSOACDS,?112,$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3),?122,"PAGE ",PSOAPG S PSOAPG=PSOAPG+1 W !
|