source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORFL.m@ 1556

Last change on this file since 1556 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1PSORFL ;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
3MAIN D INIT,LAST
4 I RFL1=0 D NEW G END
5 S RFL=RFL1 D RFL G END
6 ;
7LAST 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 ;
11NEW 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 ;
16OLD 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 ;
21INIT S RFLMSG="",LIT="*DRUG LAST FILLED UNDER RX# " Q
22 ;
23END K LIT,MK,MJK,MJK1,RFLX,RFDATE,CDRUG,II,RFL1 Q
24 ;
25RFL 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 ;
27RFLDT 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
Note: See TracBrowser for help on using the repository browser.