| 1 | PSXEDUTL ;BIR/HTW-CMOP Release/Edit Utility ;[ 04/08/97 2:06 PM ]
|
|---|
| 2 | ;;2.0;CMOP;;11 Apr 97
|
|---|
| 3 | OREL ; Called from PSODISP to check for CMOP during manual Release
|
|---|
| 4 | D LAST
|
|---|
| 5 | ; This for original fill
|
|---|
| 6 | ; No release unless cancelled.
|
|---|
| 7 | I $G(B(0))=0!($G(B(0))=1)!($G(B(0))=2) S ISUF=1 G D1
|
|---|
| 8 | Q
|
|---|
| 9 | RREL ; This for Release Refills PSODISP
|
|---|
| 10 | D LAST
|
|---|
| 11 | ; No release of fills unless cancelled
|
|---|
| 12 | RREL1 I $G(B(YY))=0!($G(B(YY))=1)!($G(B(YY))=2) S ISUF=1 G D1
|
|---|
| 13 | Q
|
|---|
| 14 | CS N YY,ISUF
|
|---|
| 15 | I +$G(XTYPE) S YY=$P($G(XTYPE),"^",2) D RREL I $G(ISUF) S PSXFLAG=1 K ISUF Q
|
|---|
| 16 | I $P($G(XTYPE),"^")="" D OREL I $G(ISUF) S PSXFLAG=1 K ISUF Q
|
|---|
| 17 | Q
|
|---|
| 18 | LAST ; Find last event, Find last fill
|
|---|
| 19 | F B=0:0 S B=$O(^PSRX(RXP,4,B)) Q:(+B<1) S B($P(^PSRX(RXP,4,B,0),"^",3))=$P(^PSRX(RXP,4,B,0),"^",4)
|
|---|
| 20 | Q
|
|---|
| 21 | D1 ;
|
|---|
| 22 | K PSXACT,PSXRXN,PSXDA,PSXRX0,PSXRXS,PSXRXP,PSXLFD,PSXRXF,PSXFDA,PSXIR
|
|---|
| 23 | K PSXACT,CNT,PPLSAVE,PSXPPL1,PSXCK,P1,P2,PSXPPL,PSXIEN,PSXDRUG,PSXLF
|
|---|
| 24 | K PSXRX,PSXSD,FLAG,NEWDT,PSXFDT,I,SUSPT,PSX1,PSX2,PSXER,PSXJOB,B,C
|
|---|
| 25 | Q
|
|---|
| 26 | SUS ; From SUP^PSORXED1 If suspense date edited to future date resuspend
|
|---|
| 27 | S RXN=DA,RX0=^PSRX(DA,0),DA=RXS,DIK="^PS(52.5," D ^DIK S DA=RXN
|
|---|
| 28 | S DIC="^PS(52.5,",DIC(0)="L",X=RXN
|
|---|
| 29 | S DIC("DR")=".02///"_SD_";.03////"_$P(^PSRX(DA,0),"^",2)_";.04///M;.05///0;.06////"_PSOSITE_";2///0;3////Q"
|
|---|
| 30 | K DD,DO
|
|---|
| 31 | D FILE^DICN
|
|---|
| 32 | K ^PS(52.5,"AC",$P(^PSRX(RXN,0),"^",2),SD,+Y)
|
|---|
| 33 | S IR=0 F FDA=0:0 S FDA=$O(^PSRX(DA,"A",FDA)) Q:'FDA S IR=FDA
|
|---|
| 34 | S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR
|
|---|
| 35 | D NOW^%DTC S ^PSRX(DA,"A",IR,0)=%_"^E^"_DUZ_"^"_RFD_"^Suspended for CMOP until "_$E(SD,4,5)_"-"_$E(SD,6,7)_"-"_$E(SD,2,3)
|
|---|
| 36 | W !,"RX# "_$P(RX0,"^")_" HAS BEEN SUSPENDED FOR CMOP UNTIL "_$E(SD,4,5)_"-"_$E(SD,6,7)_"-"_$E(SD,2,3)_".",!
|
|---|
| 37 | K PSOCMOP
|
|---|
| 38 | Q
|
|---|
| 39 | EQTY ;W !,"Y=",Y
|
|---|
| 40 | S DIR(0)="52,7" S DRG=+$P(^PSRX(ZRX,0),"^",6) S DIR("A")="QTY "_$S($D(^PSDRUG("AQ",DRG)):$G(^PSDRUG(DRG,5)),1:"")
|
|---|
| 41 | S:$P(^PSRX(ZRX,0),"^",7) DIR("B")=$P(^(0),"^",7)
|
|---|
| 42 | D ^DIR K DIR
|
|---|
| 43 | I Y["^",($L(Y)>1) W " Sorry no ^ jumping allowed" K Y G EQTY
|
|---|
| 44 | I Y["^"!($D(DTOUT)) S PSXEXIT=1
|
|---|
| 45 | K Y,DIR
|
|---|
| 46 | Q
|
|---|
| 47 | EQTY2 ;
|
|---|
| 48 | S DIR(0)="52.1,1" S DRG=+$P(^PSRX(ZRX,0),"^",6)
|
|---|
| 49 | S DIR("A")="QTY "_$S($D(^PSDRUG("AQ",DRG)):$G(^PSDRUG(DRG,5)),1:"")
|
|---|
| 50 | S DIR("B")=$P(^PSRX(ZRX,1,PSXRFL,0),"^",4)
|
|---|
| 51 | D ^DIR
|
|---|
| 52 | I Y["^",($L(Y)>1) W " Sorry no ^ jumping allowed" K Y G EQTY2
|
|---|
| 53 | I Y["^"!($D(DTOUT)) S PSXEXIT=1
|
|---|
| 54 | D QTY
|
|---|
| 55 | I $G(X)']"" G EQTY2
|
|---|
| 56 | K Y S:X>0 $P(^PSRX(ZRX,1,PSXRFL,0),"^",4)=X
|
|---|
| 57 | Q
|
|---|
| 58 | QTY ;Check quantity
|
|---|
| 59 | I X>99999999!($L(X)>11)!(X'?.N.1".".2N) K X G HELP
|
|---|
| 60 | Q
|
|---|
| 61 | HELP ; QTY HELP
|
|---|
| 62 | W !!,"This is a CMOP drug. The quantity may not contain alpha characters (i.e.; ML) or more than two decimal places (i.e.; .01)."
|
|---|
| 63 | W !,"Enter a whole number between 0 and 99999999 inclusive. The total entry cannot exceed 11 characters." K Z0
|
|---|
| 64 | Q
|
|---|
