- 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/PSOAFRPT.m
r613 r623 1 PSOAFRPT 2 ;;7.0;OUTPATIENT PHARMACY;**208**;DEC 1997;Build 41 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 BCK 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 PAUSE 95 96 97 98 ACT 99 100 101 ACT1 102 103 104 105 106 107 108 KILL 109 110 ULR 111 112 1 PSOAFRPT ;VFA/HMS autofinish reprint of a prescription label ;1/30/07 19:40 2 ;;7.0;OUTPATIENT PHARMACY;**208**;DEC 1997;Build 39 3 ; Copyright (C) 2007 WorldVistA 4 ; 5 ; This program is free software; you can redistribute it and/or modify 6 ; it under the terms of the GNU General Public License as published by 7 ; the Free Software Foundation; either version 2 of the License, or 8 ; (at your option) any later version. 9 ; 10 ; This program is distributed in the hope that it will be useful, 11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ; GNU General Public License for more details. 14 ; 15 ; You should have received a copy of the GNU General Public License 16 ; along with this program; if not, write to the Free Software 17 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 ;'Modified' MAS Patient Look-up Check Cross-References June 1987 19 ;External reference to ^PSDRUG supported by DBIA 221 20 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 21 BCK I $G(PSOBEDT) W $C(7),$C(7) S VALMSG="Invalid Action at this time !",VALMBCK="" Q 22 S PSOAFYN="Y" 23 N PSODISP S PSORPLRX=$P(PSOLST(ORN),"^",2) 24 ; 25 ;S PSOZAF="" S PSOZAF=$O(^VA(200,"B","AUTOFINISH,RX",PSOZAF)) ;vfah 26 S DIC="^VA(200,",DIC(0)="QEZ",X="AUTOFINISH,RX" 27 D ^DIC K DIC 28 S PSOZAF=+Y 29 I $P($G(^PSRX(PSORPLRX,"OR1")),"^",5)'=$G(PSOZAF) S VALMBCK="",VALMSG="Re-Print option is only available for Autofinshed Rxs",QFLG=1 D ULR,KILL K PSOZAF Q ;vfah 30 ; 31 D PSOL^PSSLOCK(PSORPLRX) I '$G(PSOMSG) S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),VALMBCK="" K PSOMSG Q 32 I $G(POERR) K QFLG D I $G(QFLG) D ULR G KILL 33 .D FULL^VALM1 S X=$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^"),Y=$P(PSOLST(ORN),"^",2)_"^"_X,Y(0)=$G(^PSRX($P(PSOLST(ORN),"^",2),0)) 34 .I $D(RXPR($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Partial Rx has been requested!",QFLG=1 Q 35 .I $D(RXRP($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Reprint Label has been requested!",QFLG=1 Q 36 .I $D(RXRS($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="Rx is being pulled from suspense!",QFLG=1 Q 37 .S RX=$P(PSOLST(ORN),"^",2) D VALID^PSORXRP1 S:$G(QFLG) VALMBCK="",VALMSG="A New Label has been requested already!" 38 S (PPL,DA,RX)=+Y,PDA=Y(0),RXF=0,ZD(DA)=DT,REPRINT=1,STA=+$G(^PSRX(+Y,"STA")) 39 I $P(^PSRX(RX,"STA"),"^")=14 S VALMBCK="",VALMSG="Cannot Reprint! Discontinued by Provider.",QFLG=1 D ULR,KILL Q 40 I $P(^PSRX(RX,"STA"),"^")=15 S VALMBCK="",VALMSG="Cannot Reprint! Discontinued due to editing.",QFLG=1 D ULR,KILL Q 41 I $P(^PSRX(RX,"STA"),"^")=16 S VALMBCK="",VALMSG="Cannot Reprint! Placed on HOLD by Provider.",QFLG=1 D ULR,KILL Q 42 I DT>$P(^PSRX(RX,2),"^",6) D G PAUSE 43 .W !,$C(7),"Medication Expired on "_$E($P(^PSRX(RX,2),"^",6),4,5)_"-"_$E($P(^(2),"^",6),6,7)_"-"_$E($P(^(2),"^",6),2,3) I $P(^PSRX(DA,"STA"),"^")<11 S $P(^PSRX(DA,"STA"),"^")=11 D 44 ..S COMM="Medication Expired on "_$E($P(^PSRX(RX,2),"^",6),4,5)_"-"_$E($P(^(2),"^",6),6,7)_"-"_$E($P(^(2),"^",6),2,3) D EN^PSOHLSN1(DA,"SC","ZE",COMM) K COMM 45 S DFN=$P(PDA,"^",2) D DEM^VADPT I $P(VADM(6),"^",2)]"" D G PAUSE 46 .W $C(7),!!,$P(^DPT($P(PDA,"^",2),0),"^")_" Died "_$P(VADM(6),"^",2)_".",! 47 .S $P(^PSRX(RX,"STA"),"^")=12,PCOM="Patient Expired "_$P(VADM(6),"^",2),ST="C" D EN^PSOHLSN1(RX,"OD","",PCOM,"A") 48 .D ACT1,ULR,KILL 49 S X=$O(^PS(52.5,"B",DA,0)) I X,'$G(^PS(52.5,X,"P")) W !,$C(7),"RX MAY NOT BE PRINTED using this option, use SUSPENSE FUNCTIONS Options." K X G PAUSE 50 S PSX=0 F J=0:0 S J=$O(^PSRX(DA,1,J)) Q:'J S PSX=J 51 K X 52 I $D(^PS(52.4,DA)) W !,"Prescription is Non-Verified",!! G PAUSE 53 S DFN=$P(^PSRX(DA,0),"^",2) I $D(^PS(52.4,"AREF",DFN,DA)) W !,"Prescription is waiting for others to be verified",!! G PAUSE 54 I $G(PSODIV),$D(^PSRX(DA,2)),+$P(^(2),"^",9),+$P(^(2),"^",9)'=PSOSITE S PSPOP=0,PSPRXN=DA D CHK1^PSOUTLA G:$G(POERR)&(PSPOP) PAUSE G:PSPOP PAUSE 55 I STA=3 W !?3,"Prescription is on Hold" G PAUSE 56 I STA=4 W !?3,"Prescription is Pending Due to Drug Interactions" G PAUSE 57 I STA=12 W !?3,"Prescription is Discontinued" G PAUSE 58 S COPIES=1 59 S SIDE=0 60 S PSODISP=0 61 I $D(DIRUT) D ULR G KILL 62 D ACT I $D(DIRUT) D ULR,KILL G PAUSE 63 Q:$G(POERR)&($D(PCOM)) G PAUSE:$D(PCOM) 64 F I=1,2,4,6,7,9,13,16 S P(I)=$P(PDA,"^",I) 65 S P(6)=+P(6) I $D(^PSRX(DA,"TN")),^("TN")]"" S P(6)=^("TN") 66 W !!,"Rx # "_P(1),?23,$E(P(13),4,5)_"/"_$E(P(13),6,7)_"/"_$E(P(13),2,3),!,$S($D(^DPT(+P(2),0)):$P(^(0),"^"),1:"Not on File"),?30,"#"_P(7),! 67 I $P($G(^PSRX(DA,"SIG")),"^",2) S D=0 D K D,FSIG 68 .D FSIG^PSOUTLA("R",DA,75) F S D=$O(FSIG(D)) W !,FSIG(D) Q:'$O(FSIG(D)) 69 E D EN3^PSOUTLA1(DA,75) S D=0 F S D=$O(BSIG(D)) W !,BSIG(D) Q:'$O(BSIG(D)) 70 K D,BSIG 71 ; 72 ;W !!,$S((P(6)=+P(6))&$D(^PSDRUG(P(6),0)):$P(^(0),"^"),1:P(6)),! S PHYS=$S($D(^VA(200,+P(4),0)):$P(^(0),"^"),1:"Unknown") W PHYS K PHYS 73 W !!,$S((P(6)=+P(6))&$D(^PSDRUG(P(6),0)):$P(^(0),"^"),1:P(6)),! 74 S PHYS=$$GET1^DIQ(200,+P(4),.01,"I") 75 I PHYS="" S PHYS="Unknown" 76 W PHYS K PHYS 77 ; 78 ;W ?25,$S($D(^VA(200,+P(16),0)):$P(^(0),"^"),1:"Unknown"),!,"# of Refills: "_$G(P(9)) 79 W ?25 80 S PSOAFENT=$$GET1^DIQ(200,+P(16),.01,"I") 81 I PSOAFENT="" S PHYS="Unknown" 82 W PSOAFENT,!,"# of Refills: "_$G(P(9)) 83 ; 84 I $G(RX) S RXFL(RX)=0 F ZZZ=0:0 S ZZZ=$O(^PSRX(RX,1,ZZZ)) Q:'ZZZ S RXFL(RX)=ZZZ 85 K PSOELSE I '$G(POERR) S PSOELSE=1 D @$S($P($G(PSOPAR),"^",26):"^PSORXL",1:"Q^PSORXL") 86 I '$G(PSOELSE) D 87 .S RXRP($P(PSOLST(ORN),"^",2))=1_"^"_COPIES_"^"_SIDE 88 .I $G(PSODISP)=1 S RXRP($P(PSOLST(ORN),"^",2),"RP")=1 89 .I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=DA_"," Q 90 .F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 91 .I $L(PSORX("PSOL",PSOX2))+$L(DA)<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_DA_"," 92 .E S PSORX("PSOL",PSOX2+1)=DA_"," 93 K PCOMX,PSPOP,PPL,COPIES,SIDE,PCOM,IOP,PSL,PSNP,PSOELSE,ZZZ 94 PAUSE K RX,PPL,ZD(+$G(DA)),DA I $G(POERR) K DIR,DIRUT,DUOUT,DTOUT S DIR(0)="E",DIR("A",1)=" ",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DUOUT,DTOUT S VALMBCK="R" 95 D ULR K PSORPLRX 96 Q 97 ; 98 ACT K DIR S DIR("A")="Comments: ",DIR(0)="FA^5:60",DIR("?")="5-60 characters input required for activity log." S:$G(PCOMX)]"" DIR("B")=$G(PCOMX) 99 D ^DIR K DIR Q:$D(DIRUT)!($D(DIROUT)) S (PCOM,PCOMX)=X 100 I '$D(PSOCLC) S PSOCLC=DUZ 101 ACT1 S RXF=0 F J=0:0 S J=$O(^PSRX(DA,1,J)) Q:'J S RXF=J S:J>5 RXF=J+1 102 S IR=0 F J=0:0 S J=$O(^PSRX(DA,"A",J)) Q:'J S IR=J 103 S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR 104 D NOW^%DTC S ^PSRX(DA,"A",IR,0)=%_"^"_$S($G(ST)'="C":"W",1:"C")_"^"_DUZ_"^"_RXF_"^"_PCOM_$S($G(ST)'="C":" ("_COPIES_" COPIES)",1:""),PCOMX=PCOM K PC,IR,PS,PCOM,XX,%,%H,%I,RXF 105 S:$P(^PSRX(DA,2),"^",15)&($G(ST)'="C") $P(^PSRX(DA,2),"^",14)=1 106 Q 107 ; 108 KILL K QFLG,%,DIR,DUOUT,DTOUT,DIROUT,DIRUT,PCOM,PCOMX,C,DA,DIC,I,J,JJJ,K,RX,RXF,X,Y,Z,DFN,P,PDA,PSPRXN,COPIES,SIDE,PPL,REPRINT,PSOMSG,PSORPLRX D KVA^VADPT Q 109 ; 110 ULR ; 111 I $G(PSORPLRX) D PSOUL^PSSLOCK(PSORPLRX) 112 Q
Note:
See TracChangeset
for help on using the changeset viewer.
