| 1 | PSOARCTG ;BHAM ISC/LGH - gather tape info ; 07/07/92
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**10**;DEC 1997
|
|---|
| 3 | AC S DFN=DA,TA=$S($D(PSOAT):1,1:0) K T D ADD^VADPT,DEM^VADPT,ELIG^VADPT
|
|---|
| 4 | S I=$P($G(VADM(3)),"^")
|
|---|
| 5 | S T(1)=$G(VADM(1))_"^"_$P($G(VADM(2)),"^")_"^"_$P($G(VAEL(1)),"^",2)
|
|---|
| 6 | 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:"")
|
|---|
| 7 | S T(1)=T(1)_"^"_$G(VAPA(4))_"^"_$P($G(VAPA(5)),"^",2)_"^"_$G(VAPA(6))_"^"
|
|---|
| 8 | I $D(^PS(55,DFN,0)),+$P(^(0),"^",2) S T(1)=T(1)_1_"^" S:+$P(^(0),"^",4) T(1)=T(1)_1
|
|---|
| 9 | S T(2)="" I $D(^PS(55,DFN,1)),^(1)]"" S T(2)=T(2)_^(1)
|
|---|
| 10 | 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))
|
|---|
| 11 | 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
|
|---|
| 12 | S T(2)=$P(T(2),"^")_"^"_(TZ-1)_"^"_$P(T(2),"^",3,99)
|
|---|
| 13 | MA S GMRA="0^0^111" D ^GMRADPT
|
|---|
| 14 | 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
|
|---|
| 15 | S T(2)=$P(T(2),"^",1,2)_"^"_(TZ-1)_"^"_$P(T(2),"^",4,99)
|
|---|
| 16 | END D KVA^VADPT K GMRAL,TZ,SC
|
|---|
| 17 | Q Q
|
|---|
| 18 | CMOP ;Called by ACT+1^PSOARX Prints CMOP Data for "Display Archived Rx's"
|
|---|
| 19 | F Z1=0:0 S Z1=$O(^PSRX(DA,4,Z1)) Q:(+$G(Z1)<1) S ZZ1=^(Z1,0) D
|
|---|
| 20 | .I $Y'>(PSOACPL-20),(Z1=1) D C1
|
|---|
| 21 | .D:$Y>(PSOACPL-20) HD1,C1
|
|---|
| 22 | .S Y=$P($G(ZZ1),"^",5) I Y X ^DD("DD") S $P(ZZ1,"^",5)=$P(Y,"@") K Y
|
|---|
| 23 | .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")
|
|---|
| 24 | .W !,Z1,?3,$P(ZZ1,"^")_"-"_$P(ZZ1,"^",2)
|
|---|
| 25 | .W ?22,$J($P(ZZ1,"^",3),3),?30,$P(ZZ1,"^",4)
|
|---|
| 26 | .S ZZ2=$G(^PSRX(DA,4,Z1,1)) I $G(ZZ2)]"" D
|
|---|
| 27 | ..S Y=$P(ZZ2,"^",2) I $G(Y)]"" X ^DD("DD") S $P(ZZ2,"^",2)=$P(Y,"@") K Y
|
|---|
| 28 | ..W ?40,$P(ZZ2,"^",2),?52,$E($P(ZZ2,"^",3),1,20),?74,$E($P(ZZ2,"^",4),1,20) K ZZ2
|
|---|
| 29 | .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:"")
|
|---|
| 30 | K ZZ1,Z1,ZST,ZZ2
|
|---|
| 31 | F Z1=0:0 S Z1=$O(^PSRX(DA,5,Z1)) Q:'Z1 S ZZ1=^(Z1,0) D
|
|---|
| 32 | .I $Y'>(PSOACPL-20),(Z1=1) D C2
|
|---|
| 33 | .D:$Y>(PSOACPL-20) HD1,C2
|
|---|
| 34 | .S Y=$P($G(ZZ1),"^",2) I Y X ^DD("DD") S $P(ZZ1,"^",2)=Y
|
|---|
| 35 | .W !,Z1,?5,$P(ZZ1,"^"),?51,$J($P(ZZ1,"^",2),12),?71,$J($P(ZZ1,"^",3),3)
|
|---|
| 36 | K Z1,ZZ1,ZST
|
|---|
| 37 | Q
|
|---|
| 38 | C1 W !!,"CMOP EVENT LOG"
|
|---|
| 39 | W !,"#",?5,"TRANS #",?20,"RX REF",?30,"STATUS",?40,"SHIP DATE",?52,"CARRIER",?76,"PACKAGE ID",?100,"REMARKS"
|
|---|
| 40 | W ! F I=1:1:120 W "="
|
|---|
| 41 | Q
|
|---|
| 42 | C2 W !!,"CMOP LOT#/EXPIRATION DATE LOG"
|
|---|
| 43 | W !,"#",?15,"LOT #",?49,"EXPIRATION DATE",?70,"RX REF"
|
|---|
| 44 | W ! F I=1:1:80 W "="
|
|---|
| 45 | Q
|
|---|
| 46 | 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 !
|
|---|
