| 1 | PSXVIEW ;BIR/HTW-CMOP Data for View Prescription ;[ 02/02/98  7:46 AM ] | 
|---|
| 2 | ;;2.0;CMOP;**11**;11 Apr 97 | 
|---|
| 3 | S PSXM=$O(^PSRX(DA,4,0)) G:'$G(PSXM) FINI K PSXM | 
|---|
| 4 | D PAGE Q:$G(ANS)]"" | 
|---|
| 5 | FOUR ;  Get data from event multiple | 
|---|
| 6 | D HEADER | 
|---|
| 7 | F PSXA=0:0 S PSXA=$O(^PSRX(DA,4,PSXA)) Q:'PSXA!($G(ANS)["^")  S PSX4=^(PSXA,0) D | 
|---|
| 8 | .D FIX | 
|---|
| 9 | .I $Y>20 D PAGE Q:$G(ANS)["^"  D HEADER | 
|---|
| 10 | .D PRINT Q:$G(ANS)["^" | 
|---|
| 11 | D JUMP Q:$G(ANS)["^" | 
|---|
| 12 | D PSXLOT | 
|---|
| 13 | FINI K ANS,Y,%,I,Z,PSXLOT,PSXL,PSX4,F,PSXA,C,ER,PSXFIL,PSX4,PSXREA,PSXVID | 
|---|
| 14 | K PSXREL,PSXTRDT,PSXT,PSXLOC,DTOUT,DUOUT,PSXSEQ,PSXA,PSXML,P,I1,I2 | 
|---|
| 15 | K PSXP,PSXE,PSXE1,PSXERR,PSXBAT,ZD1,ZD2,ZDT,RXREF,PSXZ,PSXTST,PSXTCAN | 
|---|
| 16 | K PSXRDT,PSXNDC,PSXM,PSXL1,PSXCAN,PSX1,EXPDT,PSXBREF,RXREF1 | 
|---|
| 17 | Q | 
|---|
| 18 | PRINT ; | 
|---|
| 19 | W !!,$S($G(PSXTST)=3:PSXTCAN,$G(PSXTST)=1:$G(PSXRDT),1:$G(PSXTRDT)) | 
|---|
| 20 | W ?15,$S(PSXFIL=0:"ORIG",1:"REF "_$G(PSXFIL)) | 
|---|
| 21 | W ?22,$G(PSXBREF) | 
|---|
| 22 | W ?36,$G(PSXT) | 
|---|
| 23 | W ?42,$S($G(PSXTST)=3:$E($G(PSXCAN),1,35),$G(PSXNDC)]"":"NDC: "_PSXNDC,1:"") | 
|---|
| 24 | Q | 
|---|
| 25 | PSXLOT ; | 
|---|
| 26 | Q:$O(^PSRX(DA,5,0))'>0 | 
|---|
| 27 | W @IOF | 
|---|
| 28 | W "CMOP LOT#/EXPIRATION DATE LOG:" | 
|---|
| 29 | W !,"RX REF",?20,"LOT #",?40,"EXPIRATION DATE",! | 
|---|
| 30 | D Z1 | 
|---|
| 31 | W ! | 
|---|
| 32 | F PSXZ=0:0 S PSXZ=$O(^PSRX(DA,5,PSXZ)) Q:PSXZ']""  S PSXLOT=^(PSXZ,0) D | 
|---|
| 33 | .S EXPDT=$P(PSXLOT,U,2) | 
|---|
| 34 | .S EXPDT=$E(EXPDT,4,5)_"/"_$E(EXPDT,6,7)_"/"_$E(EXPDT,2,3) | 
|---|
| 35 | .S RXREF=$P(PSXLOT,U,3) | 
|---|
| 36 | .W !,$S(RXREF=0:"ORIG",RXREF>0:"REF "_RXREF,1:""),?20,$P(PSXLOT,U),?43,EXPDT | 
|---|
| 37 | .Q | 
|---|
| 38 | JUMP S PSXL=22-$Y F PSXP=1:1:PSXL W ! | 
|---|
| 39 | PAGE K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue or ""^"" to exit" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) (ANS)="^" | 
|---|
| 40 | Q | 
|---|
| 41 | HEADER ; | 
|---|
| 42 | W @IOF,"CMOP EVENT LOG:" | 
|---|
| 43 | W !,"DATE",?15,"RX REF",?22,"TRN-ORDER #",?36,"STAT",?42,"COMMENTS" | 
|---|
| 44 | W ! F C=1:1:79 W "=" | 
|---|
| 45 | Q | 
|---|
| 46 | FIX ; Translate data | 
|---|
| 47 | S PSXBAT=$P(PSX4,U),PSXSEQ=$P(PSX4,U,2) | 
|---|
| 48 | S PSXFIL=$P(PSX4,U,3),PSXTST=$P(PSX4,U,4) | 
|---|
| 49 | S PSXBREF=$G(PSXBAT)_"-"_$G(PSXSEQ) | 
|---|
| 50 | S PSXZT=$P(PSX4,U,5),PSXZT1=$P(PSXZT,"."),PSXZT2=$P(PSXZT,".",2) | 
|---|
| 51 | I $G(PSXZT)']"" K PSXZT,PSXZT1,PSXZT2 G F1 | 
|---|
| 52 | S PSXZT2=$E(PSXZT2,1,4) | 
|---|
| 53 | S PSXZT1=$E(PSXZT1,4,5)_"/"_$E(PSXZT1,6,7)_"/"_$E(PSXZT1,2,3) | 
|---|
| 54 | S PSXTCAN=PSXZT1_"@"_PSXZT2 K PSXZT1,PSXZT2,PSXZT | 
|---|
| 55 | F1 S PSXNDC=$P(PSX4,U,8) | 
|---|
| 56 | S PSXCAN=$G(^PSRX(DA,4,PSXA,1)) | 
|---|
| 57 | ; Get CMOP site | 
|---|
| 58 | S I1=$O(^PSX(550.2,"B",PSXBAT,"")) | 
|---|
| 59 | P1 ; Get transmission d/t | 
|---|
| 60 | S ZDT=$P(^PSX(550.2,I1,0),U,6),ZD1=$P(ZDT,"."),ZD2=$P(ZDT,".",2) | 
|---|
| 61 | S ZD2=$E(ZD2,1,4) | 
|---|
| 62 | S ZD1=$E(ZD1,4,5)_"/"_$E(ZD1,6,7)_"/"_$E(ZD1,2,3) | 
|---|
| 63 | S PSXTRDT=ZD1_"@"_ZD2 | 
|---|
| 64 | Q1 S:PSXTST=0 PSXT="TRAN" | 
|---|
| 65 | I PSXTST=1 D | 
|---|
| 66 | .I PSXFIL>0,('$D(^PSRX(DA,1,PSXFIL,0))) S PSXT="DISP REFILL DELETED" Q | 
|---|
| 67 | .S PSX1=$S(PSXFIL=0:$P(^PSRX(DA,2),"^",13),1:$P(^PSRX(DA,1,PSXFIL,0),"^",18)) | 
|---|
| 68 | .Q:PSX1']"" | 
|---|
| 69 | .I PSX1'["." S PSXRDT=$E(PSX1,4,5)_"/"_$E(PSX1,6,7)_"/"_$E(PSX1,2,3) G SKIP | 
|---|
| 70 | .S ZR=PSX1,ZR1=$P(ZR,"."),ZR2=$P(ZR,".",2) | 
|---|
| 71 | .S ZR2=$E(ZR2,1,4) | 
|---|
| 72 | .S PSXRDT=$E(ZR1,4,5)_"/"_$E(ZR1,6,7)_"/"_$E(ZR1,2,3)_"@"_ZR2 | 
|---|
| 73 | .K ZR,ZR1,ZR2 | 
|---|
| 74 | SKIP .S PSXT="DISP" | 
|---|
| 75 | S:PSXTST=2 PSXT="RTRN" | 
|---|
| 76 | S:PSXTST=3 PSXT="NDISP" | 
|---|
| 77 | Q | 
|---|
| 78 | T1 X ^DD("DD") Q | 
|---|
| 79 | Z1 F C=1:1:79 W "=" | 
|---|
| 80 | K C | 
|---|
| 81 | Q | 
|---|