| [613] | 1 | PSORFL ;BHAM ISC/CMD - THIS PROGRAM DETERMINES THE LAST FILL OF AN RX AND WHETHER ; 05/15/92 8:10
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**19**;DEC 1997
|
|---|
| 3 | MAIN D INIT,LAST
|
|---|
| 4 | I RFL1=0 D NEW G END
|
|---|
| 5 | S RFL=RFL1 D RFL G END
|
|---|
| 6 | ;
|
|---|
| 7 | LAST S RFL1=0,RFL=$P(^PSRX(II,2),"^",2),RFLL=$P($G(^PSRX(II,3)),"^"),RFL=$S($O(^PSRX(II,1,0)):RFLL,1:RFL)
|
|---|
| 8 | ;I $P(^PSRX(II,"STA"),"^")'=3 F MJK=0:0 S MJK=$O(^PSRX(II,1,MJK)) Q:'MJK S RFDATE=+^(MJK,0) S:RFL'>RFDATE RFL1=RFL,RFL=RFDATE
|
|---|
| 9 | S RFDATE=RFL D RFL K MJK Q
|
|---|
| 10 | ;
|
|---|
| 11 | NEW S CDRUG=$P(^PSRX(II,0),"^",6),RFL=0
|
|---|
| 12 | F MJK=0:0 S MJK=$O(^PS(55,DFN,"P",MJK)) Q:'MJK S MK=+^(MJK,0) I II'=MK,$D(^PSRX(MK,0)),$P(^(0),"^",6)=CDRUG D OLD
|
|---|
| 13 | I RFL=0 S RFL="N/A" Q
|
|---|
| 14 | D RFL Q
|
|---|
| 15 | ;
|
|---|
| 16 | OLD S RFLX=$P(^PSRX(MK,0),"^",13) I $D(^(2)),$P(^(2),"^",2)]"" S RFLX=$P(^(2),"^",2)
|
|---|
| 17 | S:RFL'>RFLX RFL=RFLX,RFLMSG=LIT_$P(^PSRX(MK,0),"^")
|
|---|
| 18 | F MJK1=0:0 S MJK1=$O(^PSRX(MK,1,MJK1)) Q:'MJK1 S RFDATE=$P(^PSRX(MK,1,MJK1,0),"^") S:RFL'>RFDATE RFL=RFDATE,RFLMSG=LIT_$P(^PSRX(MK,0),"^")
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | INIT S RFLMSG="",LIT="*DRUG LAST FILLED UNDER RX# " Q
|
|---|
| 22 | ;
|
|---|
| 23 | END K LIT,MK,MJK,MJK1,RFLX,RFDATE,CDRUG,II,RFL1 Q
|
|---|
| 24 | ;
|
|---|
| 25 | RFL S:RFL RFL=$E(RFL,4,5)_"/"_$E(RFL,6,7)_"/"_$E(RFL,2,3) S:RFLL RFLL=$E(RFLL,4,5)_"/"_$E(RFLL,6,7)_"/"_($E(RFLL,1,3)+1700) Q
|
|---|
| 26 | ;
|
|---|
| 27 | RFLDT S II=RX
|
|---|
| 28 | S (PSOFLRD,PSOLASTF,PSLASTRX)="" S PSOFLO=$P(^PSRX(II,2),"^",2) F PSOFLR=0:0 S PSOFLR=$O(^PSRX(II,1,PSOFLR)) Q:'PSOFLR S PSOFLRD=+^PSRX(II,1,PSOFLR,0)
|
|---|
| 29 | I '$G(PSOFLRD) S PSOODRUG=$P(^PSRX(II,0),"^",6) F YYY=0:0 S YYY=$O(^PS(55,DFN,"P",YYY)) Q:'YYY S PSOLDRX=+^(YYY,0) I II'=PSOLDRX,$P($G(^PSRX(PSOLDRX,0)),"^",6)=PSOODRUG S PSLASTRX=PSOLDRX D S:PSPRERX>$G(PSOLASTF) PSOLASTF=PSPRERX
|
|---|
| 30 | .S PSPRERX=$P($G(^PSRX(PSLASTRX,2)),"^",2) I $O(^PSRX(PSLASTRX,1,0)) F RRR=0:0 S RRR=$O(^PSRX(PSLASTRX,1,RRR)) Q:'RRR S PSPRERX=$P($G(^PSRX(PSLASTRX,1,RRR,0)),"^")
|
|---|
| 31 | I '$G(PSOFLRD),'$G(PSLASTRX) S PSOLASTF="N/A"
|
|---|
| 32 | I $G(PSOFLRD) F SSS=0:0 S SSS=$O(^PSRX(II,1,SSS)) Q:'SSS S SSSNUM=SSS
|
|---|
| 33 | I $G(PSOFLRD) S SSSNUM=SSSNUM-1 S:SSSNUM=0 PSOLASTF=$P($G(^PSRX(II,2)),"^",2) S:SSSNUM>0 PSOLASTF=$P($G(^PSRX(II,1,SSSNUM,0)),"^")
|
|---|
| 34 | S:PSOLASTF'="N/A" PSOLASTF=$E(PSOLASTF,4,5)_"/"_$E(PSOLASTF,6,7)_"/"_($E(PSOLASTF,1,3)+1700)
|
|---|
| 35 | K PSOFLRD,PSOFLO,PSOFLR,PSOODRUG,PSOLDRX,PSLASTRX,PSPRERX,YYY,SSS,SSSNUM Q
|
|---|
