PSORFL ;BHAM ISC/CMD - THIS PROGRAM DETERMINES THE LAST FILL OF AN RX AND WHETHER ; 05/15/92 8:10 ;;7.0;OUTPATIENT PHARMACY;**19**;DEC 1997 MAIN D INIT,LAST I RFL1=0 D NEW G END S RFL=RFL1 D RFL G END ; 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) ;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 S RFDATE=RFL D RFL K MJK Q ; NEW S CDRUG=$P(^PSRX(II,0),"^",6),RFL=0 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 I RFL=0 S RFL="N/A" Q D RFL Q ; OLD S RFLX=$P(^PSRX(MK,0),"^",13) I $D(^(2)),$P(^(2),"^",2)]"" S RFLX=$P(^(2),"^",2) S:RFL'>RFLX RFL=RFLX,RFLMSG=LIT_$P(^PSRX(MK,0),"^") 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),"^") Q ; INIT S RFLMSG="",LIT="*DRUG LAST FILLED UNDER RX# " Q ; END K LIT,MK,MJK,MJK1,RFLX,RFDATE,CDRUG,II,RFL1 Q ; 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 ; RFLDT S II=RX 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) 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 .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)),"^") I '$G(PSOFLRD),'$G(PSLASTRX) S PSOLASTF="N/A" I $G(PSOFLRD) F SSS=0:0 S SSS=$O(^PSRX(II,1,SSS)) Q:'SSS S SSSNUM=SSS 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)),"^") S:PSOLASTF'="N/A" PSOLASTF=$E(PSOLASTF,4,5)_"/"_$E(PSOLASTF,6,7)_"/"_($E(PSOLASTF,1,3)+1700) K PSOFLRD,PSOFLO,PSOFLR,PSOODRUG,PSOLDRX,PSLASTRX,PSPRERX,YYY,SSS,SSSNUM Q