- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORRNW.m
r613 r623 1 PSOORRNW ;BIR/SAB-finish OP renew orders from OE/RR ;4/25/07 8:46am 2 ;;7.0;OUTPATIENT PHARMACY;**11,27,51,46,71,94,130,131,146,206,225**;DEC 1997;Build 29 3 ;External reference to ^PSDRUG supported by DBIA 221 4 ;External reference to ^PS(50.607 supported by DBIA 2221 5 ;External reference to ^PS(51.2 supported by DBIA 2226 6 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 7 S PSORENXX=$P($G(OR0),"^",21),PSOFROM="NEW" K PRC,PHI 8 I $G(PSORENXX) D PSOL^PSSLOCK(PSORENXX) I '$G(PSOMSG) D K DIR,PSOMSG W ! S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR K DIR W ! Q 9 .I $P($G(PSOMSG),"^",2)'="" W $C(7),!!,$P(PSOMSG,"^",2) Q 10 .W $C(7),!!,"Another person is editing Rx "_$P($G(^PSRX(PSORENXX,0)),"^") 11 K PSOMSG N OI,VALMCNT K POERR("DFLG") D FULL^VALM1 S (PSORX("DFLG"),PSORENW("DFLG"))=0,(PSORNW("FILL DATE"),PSORENW("FILL DATE"))=DT 12 S Y=DT X ^DD("DD") S PSORX("FILL DATE")=Y K Y 13 ; 14 I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 D Q:$D(DIRUT)!'Y D EN1^ORCFLAG(+$P($G(^PS(52.41,ORD,0)),"^")) H 1 15 . K DIRUT,DUOUT,DTOUT,DIR 16 . S DIR("A",1)="This Renewal Request is flagged. In order to process it" 17 . S DIR("A",2)="you must unflag it first." 18 . S DIR("A",3)="" 19 . S DIR(0)="Y",DIR("A")="Unflag Renewal Request",DIR("B")="NO" 20 . W ! D ^DIR I $D(DIRUT)!'Y S VALMBCK="Q" 21 I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 Q 22 ; 23 W !!,"Now Renewing Rx # "_$P(^PSRX($P(OR0,"^",21),0),"^")_" Drug: "_$P($G(^PSDRUG($P(^PSRX($P(OR0,"^",21),0),"^",6),0)),"^"),! H 2 24 I $P($G(^PSRX($P(OR0,"^",21),"OR1")),"^",4) D D PROCESSX^PSORENW0 D UL Q 25 .W !!,"Cannot Renew Rx # "_$P(^PSRX($P(OR0,"^",21),0),"^"),!," Drug: "_$P($G(^PSDRUG($P(^PSRX($P(OR0,"^",21),0),"^",6),0)),"^")_"." 26 .W !,"This Rx has already been RENEWED ("_$P(^PSRX($P(^PSRX($P(OR0,"^",21),"OR1"),"^",4),0),"^")_").",! 27 .S ACOM="Duplicate Renewal Request. Order rejected by Pharmacy.",PSONOOR="D" D DE^PSOORFI2 K ACOM,POERR("COMM"),POERR("PLACER"),POERR("STAT") 28 I '$G(PSOTPBFG) D DSPL^PSOTPCAN(ORD) 29 S (PSORX("PROVIDER NAME"),PSORENW("PROVIDER NAME"))=$P(^VA(200,$P(OR0,"^",5),0),"^"),PSORENW("NOO")=$P(OR0,"^",7) 30 S PSORENW("PROVIDER")=$P(OR0,"^",5),PSORENW("MAIL/WINDOW")=$S($P(OR0,"^",17)="M":"M",1:"W") 31 ;I $O(^PSRX($P(OR0,"^",21),"PRC",0)) F I=0:0 S I=$O(^PSRX($P(OR0,"^",21),"PRC",I)) Q:'I S PRC(I)=^PSRX($P(OR0,"^",21),"PRC",I,0) 32 K II F I=0:0 S I=$O(^PS(52.41,ORD,1,I)) Q:'I S DOSE=$G(^PS(52.41,ORD,1,I,1)),DOSE1=$G(^(2)) D 33 .S II=$G(II)+1 34 .S PSORENW("DOSE",II)=$P(DOSE1,"^"),PSORENW("DOSE ORDERED",II)=$P(DOSE1,"^",2),PSORENW("UNITS",II)=$P(DOSE,"^",9),PSORENW("NOUN",II)=$P(DOSE,"^",5) 35 .S:$P(DOSE,"^",9) UNITS=$P(^PS(50.607,$P(DOSE,"^",9),0),"^") 36 .S PSORENW("VERB",II)=$P(DOSE,"^",10),PSORENW("ROUTE",II)=$P(DOSE,"^",8) 37 .S:$P(DOSE,"^",8) ROUTE=$P(^PS(51.2,$P(DOSE,"^",8),0),"^") 38 .S PSORENW("SCHEDULE",II)=$P(DOSE,"^"),PSORENW("DURATION",II)=$P(DOSE,"^",2) 39 .I $P(DOSE,"^",6)]"" S PSORENW("CONJUNCTION",II)=$S($P(DOSE,"^",6)="S":"T",$P(DOSE,"^",6)="X":"X",1:"A") 40 S PSORENW("ENT")=+$G(II) K II,I 41 F DR=1:1:PSORENW("ENT") I $G(PSORENW("DURATION",DR))]"" D 42 .S DUR1=PSORENW("DURATION",DR) 43 .S PSORENW("DURATION",DR)=$S($E(DUR1,1)'?.N:$E(DUR1,2,99)_$E(DUR1,1),1:DUR1) 44 D ^PSORENW1,CHECK^PSORENW0 I PSORENW("DFLG") D KLIB^PSORENW1 D PROCESSX^PSORENW0 D UL Q 45 D FILDATE^PSORENW0,DRUG^PSORENW0 I PSORENW("DFLG")!$G(PSORX("DFLG")) D KLIB^PSORENW1 D PROCESSX^PSORENW0 D UL Q 46 D RXN^PSORENW0 I PSORENW("DFLG") D KLIB^PSORENW1 D PROCESSX^PSORENW0 D UL Q 47 D STOP^PSORENW1,INIT^PSORENW3 48 I $G(PSOORRNW) D 49 .S PSORENW("ISSUE DATE")=$S(PSORENW("FILL DATE")>DT:DT,PSORENW("FILL DATE")<$E($P(OR0,"^",6),1,7):PSORENW("FILL DATE"),1:$E($P(OR0,"^",6),1,7)) 50 .S PSORENW("# OF REFILLS")=+$P(OR0,"^",11),PSOFDR=1 51 .S PSORENW("CLERK CODE")=$P(OR0,"^",4),PSORX("CLERK CODE")=$P(^VA(200,$P(OR0,"^",4),0),"^") 52 ;D CHK 53 S PSOFXRN=0,PSOFXRNX=1 54 S PSORENW("POE")=$S($G(^PS(52.41,ORD,"POE"))=1:1,'$O(^PSRX($P(OR0,"^",21),6,0)):1,1:"") 55 S PSORENW("PENDING ORDER")=ORD 56 D EN^PSOORNE4(.PSORENW) K PSORENW,PSORX("FILL DATE") 57 I '$G(PSOFXRN) D UL 58 D KLIB^PSORENW1 59 K PSOFXRN,PSOFXRNX 60 Q 61 CHK ;check for valid # of refills 62 I $G(PSODRUG("DEA"))]"" D 63 .S PSOCS=0 K DIR,DIC,PSOX 64 .F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSOCS,"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSOCS,"^",2)=1 65 .;PSO*7*206 66 .S PSOMAX=$S(PSOCS:5,1:11) I PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2) S PSOMAX=0 67 E S PSOMAX=$P(OR0,"^",11) 68 S RXPT=+$P(PSORENW("RX0"),"^",3) I $G(^PS(53,RXPT,0))]"" D 69 .S PSORENW("# OF REFILLS")=$S(+$P(OR0,"^",11)>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:+$P(OR0,"^",11)),PSOX=+$P(^PS(53,RXPT,0),"^",4) 70 .S PSORENW("# OF REFILLS")=$S(PSORENW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSORENW("# OF REFILLS")) 71 .S PSOMAX=$S(PSOMAX>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:PSOMAX) K RXPT 72 E D 73 . I $G(PSOMAX) S PSORENW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11)) 74 Q 75 ; 76 EDTPEN ;edit front door renews 77 N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOORNE4 78 Q 79 UL I $G(PSORENXX) D PSOUL^PSSLOCK(PSORENXX) 80 K PSORENXX 81 Q 1 PSOORRNW ;BIR/SAB-finish OP renew orders from OE/RR ; 11/3/06 10:02pm 2 ;;7.0;OUTPATIENT PHARMACY;**11,27,51,46,71,94,130,131,146,208**;DEC 1997;Build 39 3 ; Modified from FOIA VISTA, 4 ; Copyright (C) 2007 WorldVistA 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 11 ; This program is distributed in the hope that it will be useful, 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU General Public License 17 ; along with this program; if not, write to the Free Software 18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 19 ;External reference to ^PSDRUG supported by DBIA 221 20 ;External reference to ^PS(50.607 supported by DBIA 2221 21 ;External reference to ^PS(51.2 supported by DBIA 2226 22 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 23 S PSORENXX=$P($G(OR0),"^",21),PSOFROM="NEW" K PRC,PHI 24 I $G(PSOAFYN)'="Y" I $G(PSORENXX) D PSOL^PSSLOCK(PSORENXX) I '$G(PSOMSG) D K DIR,PSOMSG W ! S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR K DIR W ! Q ;vfah 25 .I $P($G(PSOMSG),"^",2)'="" W $C(7),!!,$P(PSOMSG,"^",2) Q 26 .W $C(7),!!,"Another person is editing Rx "_$P($G(^PSRX(PSORENXX,0)),"^") 27 I $G(PSOAFYN)="Y" I $G(PSORENXX) D PSOL^PSSLOCK(PSORENXX) ;vfah 28 I $G(PSOAFYN)'="Y" K PSOMSG N OI,VALMCNT K POERR("DFLG") D FULL^VALM1 S (PSORX("DFLG"),PSORENW("DFLG"))=0,(PSORNW("FILL DATE"),PSORENW("FILL DATE"))=DT ;vfah 29 I $G(PSOAFYN)="Y" K PSOMSG N OI,VALMCNT K POERR("DFLG") S (PSORX("DFLG"),PSORENW("DFLG"))=0,(PSORNW("FILL DATE"),PSORENW("FILL DATE"))=DT ;vfah 30 S Y=DT X ^DD("DD") S PSORX("FILL DATE")=Y K Y 31 I $G(PSOAFYN)'="Y" W !!,"Now Renewing Rx # "_$P(^PSRX($P(OR0,"^",21),0),"^")_" Drug: "_$P($G(^PSDRUG($P(^PSRX($P(OR0,"^",21),0),"^",6),0)),"^"),! H 2 ;vfah 32 I $P($G(^PSRX($P(OR0,"^",21),"OR1")),"^",4) D D PROCESSX^PSORENW0 D UL Q 33 .W !!,"Cannot Renew Rx # "_$P(^PSRX($P(OR0,"^",21),0),"^"),!," Drug: "_$P($G(^PSDRUG($P(^PSRX($P(OR0,"^",21),0),"^",6),0)),"^")_"." 34 .W !,"This Rx has already been RENEWED ("_$P(^PSRX($P(^PSRX($P(OR0,"^",21),"OR1"),"^",4),0),"^")_").",! 35 .S ACOM="Duplicate Renewal Request. Order rejected by Pharmacy.",PSONOOR="D" D DE^PSOORFI2 K ACOM,POERR("COMM"),POERR("PLACER"),POERR("STAT") 36 I '$G(PSOTPBFG) D DSPL^PSOTPCAN(ORD) 37 S (PSORX("PROVIDER NAME"),PSORENW("PROVIDER NAME"))=$P(^VA(200,$P(OR0,"^",5),0),"^"),PSORENW("NOO")=$P(OR0,"^",7) 38 S PSORENW("PROVIDER")=$P(OR0,"^",5),PSORENW("MAIL/WINDOW")=$S($P(OR0,"^",17)="M":"M",1:"W") 39 I $O(^PSRX($P(OR0,"^",21),"PRC",0)) F I=0:0 S I=$O(^PSRX($P(OR0,"^",21),"PRC",I)) Q:'I S PRC(I)=^PSRX($P(OR0,"^",21),"PRC",I,0) 40 K II F I=0:0 S I=$O(^PS(52.41,ORD,1,I)) Q:'I S DOSE=$G(^PS(52.41,ORD,1,I,1)),DOSE1=$G(^(2)) D 41 .S II=$G(II)+1 42 .S PSORENW("DOSE",II)=$P(DOSE1,"^"),PSORENW("DOSE ORDERED",II)=$P(DOSE1,"^",2),PSORENW("UNITS",II)=$P(DOSE,"^",9),PSORENW("NOUN",II)=$P(DOSE,"^",5) 43 .S:$P(DOSE,"^",9) UNITS=$P(^PS(50.607,$P(DOSE,"^",9),0),"^") 44 .S PSORENW("VERB",II)=$P(DOSE,"^",10),PSORENW("ROUTE",II)=$P(DOSE,"^",8) 45 .S:$P(DOSE,"^",8) ROUTE=$P(^PS(51.2,$P(DOSE,"^",8),0),"^") 46 .S PSORENW("SCHEDULE",II)=$P(DOSE,"^"),PSORENW("DURATION",II)=$P(DOSE,"^",2) 47 .I $P(DOSE,"^",6)]"" S PSORENW("CONJUNCTION",II)=$S($P(DOSE,"^",6)="S":"T",$P(DOSE,"^",6)="X":"X",1:"A") 48 S PSORENW("ENT")=+$G(II) K II,I 49 F DR=1:1:PSORENW("ENT") I $G(PSORENW("DURATION",DR))]"" D 50 .S DUR1=PSORENW("DURATION",DR) 51 .S PSORENW("DURATION",DR)=$S($E(DUR1,1)'?.N:$E(DUR1,2,99)_$E(DUR1,1),1:DUR1) 52 D ^PSORENW1,CHECK^PSORENW0 I PSORENW("DFLG") D KLIB^PSORENW1 D PROCESSX^PSORENW0 D UL Q 53 D FILDATE^PSORENW0,DRUG^PSORENW0 I PSORENW("DFLG")!$G(PSORX("DFLG")) D KLIB^PSORENW1 D PROCESSX^PSORENW0 D UL Q 54 D RXN^PSORENW0 I PSORENW("DFLG") D KLIB^PSORENW1 D PROCESSX^PSORENW0 D UL Q 55 D STOP^PSORENW1,INIT^PSORENW3 56 I $G(PSOORRNW) D 57 .S PSORENW("ISSUE DATE")=$S(PSORENW("FILL DATE")>DT:DT,PSORENW("FILL DATE")<$E($P(OR0,"^",6),1,7):PSORENW("FILL DATE"),1:$E($P(OR0,"^",6),1,7)) 58 .S PSORENW("# OF REFILLS")=+$P(OR0,"^",11),PSOFDR=1 59 .S PSORENW("CLERK CODE")=$P(OR0,"^",4),PSORX("CLERK CODE")=$P(^VA(200,$P(OR0,"^",4),0),"^") 60 ;D CHK 61 S PSOFXRN=0,PSOFXRNX=1 62 S PSORENW("POE")=$S($G(^PS(52.41,ORD,"POE"))=1:1,'$O(^PSRX($P(OR0,"^",21),6,0)):1,1:"") 63 D EN^PSOORNE4(.PSORENW) K PSORENW,PSORX("FILL DATE") 64 I '$G(PSOFXRN) D UL 65 D KLIB^PSORENW1 66 K PSOFXRN,PSOFXRNX 67 Q 68 CHK ;check for valid # of refills 69 I $G(PSODRUG("DEA"))]"" D 70 .S PSOCS=0 K DIR,DIC,PSOX 71 .F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSOCS,"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSOCS,"^",2)=1 72 .S PSOMAX=$S(PSOCS:5,1:11) I PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F") S PSOMAX=0 73 E S PSOMAX=$P(OR0,"^",11) 74 S RXPT=+$P(PSORENW("RX0"),"^",3) I $G(^PS(53,RXPT,0))]"" D 75 .S PSORENW("# OF REFILLS")=$S(+$P(OR0,"^",11)>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:+$P(OR0,"^",11)),PSOX=+$P(^PS(53,RXPT,0),"^",4) 76 .S PSORENW("# OF REFILLS")=$S(PSORENW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSORENW("# OF REFILLS")) 77 .S PSOMAX=$S(PSOMAX>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:PSOMAX) K RXPT 78 E D 79 . I $G(PSOMAX) S PSORENW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11)) 80 Q 81 ; 82 EDTPEN ;edit front door renews 83 N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOORNE4 84 Q 85 UL I $G(PSORENXX) D PSOUL^PSSLOCK(PSORENXX) 86 K PSORENXX 87 Q
Note:
See TracChangeset
for help on using the changeset viewer.