- 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/PSORXRP2.m
r613 r623 1 PSORXRP2 ;BIR/SAB-main menu entry reprint of a Rx label ;7:37 AM 31 Dec 2008 2 ;;7.0;OUTPATIENT PHARMACY;**11,27,120,138,135,156,185,280,208**;DEC 1997;Build 41;WorldVistA 30-Jan-08 3 ; 4 ;Modified from FOIA VISTA, 5 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 6 ;General Public License See attached copy of the License. 7 ; 8 ;This program is free software; you can redistribute it and/or modify 9 ;it under the terms of the GNU General Public License as published by 10 ;the Free Software Foundation; either version 2 of the License, or 11 ;(at your option) any later version. 12 ; 13 ;This program is distributed in the hope that it will be useful, 14 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;GNU General Public License for more details. 17 ; 18 ;You should have received a copy of the GNU General Public License along 19 ;with this program; if not, write to the Free Software Foundation, Inc., 20 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 21 ; 22 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 23 ;External reference ^PS(55 supported by DBIA 2228 24 ;External reference to ^PSDRUG supported by DBIA 221 25 I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) G KILL 26 LRP N PSODISP 27 K REPRINT W !! S DIC("S")="I $P($G(^(0)),""^"",2),$D(^(""STA"")),$P($G(^(""STA"")),""^"")<10",DIC="^PSRX(",DIC("A")="Reprint Prescription Label: ",DIC(0)="QEAZ" D ^DIC K P,DIC("A") I Y<0!("^"[X) K PCOM,PCOMX G KILL 28 S (PPL,DA,RX,PSORPRX)=+Y,PDA=Y(0),RXF=0,ZD(DA)=DT,REPRINT=1,STA=+$G(^PSRX(+Y,"STA")) 29 D PSOL^PSSLOCK(PSORPRX) I '$G(PSOMSG) W !!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),! K PSOMSG G LRP 30 ;WVEHR ;begin p208 31 S DIC="^VA(200,",DIC(0)="QEZ",X="AUTOFINISH,RX" ;vfah 32 D ^DIC K DIC ;vfah 33 S PSOZAF=+Y ;vfah 34 I $P(^PSRX(RX,"OR1"),"^",5)=$G(PSOZAF) W $C(7),!,"Cannot Reprint Labels for Autofinished Rxs" D ULR,KILL Q ;vfah 35 ;WVEHR ;end p208 36 I $P(^PSRX(RX,"STA"),"^")=14 W $C(7),!,"Cannot Reprint! Discontinued by Provider." D ULR,KILL Q 37 I $P(^PSRX(RX,"STA"),"^")=15 W $C(7),!,"Cannot Reprint! Discontinued due to editing." D ULR,KILL Q 38 I $P(^PSRX(RX,"STA"),"^")=16 W $C(7),!,"Cannot Reprint! Placed on HOLD by Provider." D ULR,KILL Q 39 I DT>$P(^PSRX(RX,2),"^",6) D D ULR,KILL G LRP 40 .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 41 ..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 42 S DFN=$P(PDA,"^",2) D DEM^VADPT I $P(VADM(6),"^",2)]"" D G LRP 43 .W $C(7),!!,$P(^DPT($P(PDA,"^",2),0),"^")_" Died "_$P(VADM(6),"^",2)_".",! 44 .S $P(^PSRX(RX,"STA"),"^")=12,PCOM="Patient Expired "_$P(VADM(6),"^",2),ST="C" D EN^PSOHLSN1(RX,"OD","",PCOM,"A") 45 .D ACT1,ULR,KILL 46 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 D ULR,KILL G LRP 47 I $G(X)'>0 G GOOD 48 S XX=$P($G(^PS(52.5,X,0)),U,7) I $G(XX)']"" G GOOD 49 I $G(XX)="Q" W !,"RX CAN NOT BE PRINTED using this option, use SUSPENSE FUNCTIONS Options." K X,XX D ULR,KILL G LRP 50 I $G(XX)="L" W !,"RX is being transmitted to the CMOP and can not be reprinted now." K X,XX D ULR,KILL G LRP 51 GOOD K X 52 I $D(^PS(52.4,DA)) W !,"Prescription is Non-Verified",!! D ULR,KILL G LRP 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",!! D ULR,KILL G LRP 54 I $G(PSODIV),$D(^PSRX(DA,2)),+$P(^(2),"^",9),+$P(^(2),"^",9)'=PSOSITE S PSPOP=0,PSPRXN=DA D CHK1^PSOUTLA I PSPOP D ULR,KILL G LRP 55 I STA=3 W !?3,"Prescription is on Hold" D ULR,KILL G LRP 56 I STA=4 W !?3,"Prescription is Pending Due to Drug Interactions" D ULR,KILL G LRP 57 I STA=12 W !?3,"Prescription is Discontinued" D ULR,KILL G LRP 58 I $G(^PS(55,"ASTALK",DFN)) W !,"Patient is a ScripTalk patient. Use ScripTalk label for prescription bottle.",! 59 D ICN^PSODPT(DFN) 60 S COPIES=$S($P(PDA,"^",18)]"":$P(PDA,"^",18),1:1) 61 K DIR S DIR("A")="Number of Copies? ",DIR("B")=COPIES,DIR(0)="N^1:99:0",DIR("?")="Enter the number of copies you want (1 TO 99)" 62 D ^DIR K DIR I $D(DIRUT) D ULR,KILL G LRP 63 S COPIES=Y 64 K DIR S DIR("A")="Print adhesive portion of label only? ",DIR(0)="Y",DIR("B")="No",DIR("?",1)="If entire label, including trailers are to print press RETURN for default." 65 S DIR("?")="Else if only bottle and mailing labels are to print enter Y or YES." D ^DIR K DIR I $D(DUOUT) D ULR,KILL G LRP 66 I $D(DIRUT) D ULR G KILL 67 S SIDE=Y 68 I $P(PSOPAR,"^",30),$$GET1^DIQ(59,PSOSITE_",",105,"I")=2.4 D 69 .I $S($P(PSOPAR,"^",30)=3:1,$P(PSOPAR,"^",30)=4:1,1:0),'$$GET1^DIQ(50,$P(PDA,"^",6),28,"I") Q 70 .K DIR,DIRUT S DIR("A")="Do you want to resend to Dispensing System Device",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR Q:$D(DIRUT) S PSODISP=$S(Y:0,1:1) 71 I $D(DIRUT) D ULR,KILL G LRP 72 D ACT I $D(DIRUT) D ULR,KILL G LRP 73 I $D(PCOM) D ULR,KILL G LRP 74 F I=1,2,4,6,7,9,13,16 S P(I)=$P(PDA,"^",I) 75 S P(6)=+P(6) I $D(^PSRX(DA,"TN")),^("TN")]"" S P(6)=^("TN") 76 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),! 77 I $P($G(^PSRX(DA,"SIG")),"^",2) S D=0 D K D,FSIG 78 .D FSIG^PSOUTLA("R",DA,75) F S D=$O(FSIG(D)) W !,FSIG(D) Q:'$O(FSIG(D)) 79 E D EN3^PSOUTLA1(DA,75) S D=0 F S D=$O(BSIG(D)) W !,BSIG(D) Q:'$O(BSIG(D)) 80 K D,BSIG 81 ;PSO*7*280 If Trade name, don't lookup in ^PSDRUG 82 W !!,$S($G(^PSRX(DA,"TN"))]"":P(6),(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 83 W ?25,$S($D(^VA(200,+P(16),0)):$P(^(0),"^"),1:"Unknown"),!,"# of Refills: "_$G(P(9)) 84 I $G(RX) D 85 .S RXRP(RX)=1_"^"_COPIES_"^"_SIDE 86 .I $G(PSODISP)=1 S RXRP(RX,"RP")=1 87 .S RXFL(RX)=0 F ZZZ=0:0 S ZZZ=$O(^PSRX(RX,1,ZZZ)) Q:'ZZZ S RXFL(RX)=ZZZ 88 D @$S($P($G(PSOPAR),"^",26):"^PSORXL",1:"Q^PSORXL") K PSPOP,PPL,COPIES,SIDE,REPRINT,PCOM,IOP,PSL,PSNP,ZZZ,RXFL(+$G(RX)) D ULR,KILL G LRP 89 ; 90 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) 91 D ^DIR K DIR Q:$D(DIRUT)!($D(DIROUT)) S (PCOM,PCOMX)=X 92 I '$D(PSOCLC) S PSOCLC=DUZ 93 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 94 S IR=0 F J=0:0 S J=$O(^PSRX(DA,"A",J)) Q:'J S IR=J 95 S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR 96 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 97 S:$P(^PSRX(DA,2),"^",15)&($G(ST)'="C") $P(^PSRX(DA,2),"^",14)=1 98 Q 99 ; 100 KILL K %,DIR,DUOUT,DTOUT,DIROUT,DIRUT,C,DA,DIC,I,J,JJJ,K,RX,RXF,X,Y,Z,ZD,DFN,P,PDA,PSPRXN,COPIES,SIDE,PPL,REPRINT,PSXSTAT,PSORPRX,PSOMSG D KVA^VADPT Q 101 ; 102 ULR ; 103 I $G(PSORPRX) D PSOUL^PSSLOCK(PSORPRX) 104 Q 1 PSORXRP2 ;BIR/SAB-main menu entry reprint of a Rx label ; 12/10/06 9:51pm 2 ;;7.0;OUTPATIENT PHARMACY;**11,27,120,138,135,156,185,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 references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 20 ;External reference ^PS(55 supported by DBIA 2228 21 ;External reference to ^PSDRUG supported by DBIA 221 22 I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) G KILL 23 LRP N PSODISP 24 K REPRINT W !! S DIC("S")="I $P($G(^(0)),""^"",2),$D(^(""STA"")),$P($G(^(""STA"")),""^"")<10",DIC="^PSRX(",DIC("A")="Reprint Prescription Label: ",DIC(0)="QEAZ" D ^DIC K P,DIC("A") I Y<0!("^"[X) K PCOM,PCOMX G KILL 25 S (PPL,DA,RX,PSORPRX)=+Y,PDA=Y(0),RXF=0,ZD(DA)=DT,REPRINT=1,STA=+$G(^PSRX(+Y,"STA")) 26 D PSOL^PSSLOCK(PSORPRX) I '$G(PSOMSG) W !!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),! K PSOMSG G LRP 27 S DIC="^VA(200,",DIC(0)="QEZ",X="AUTOFINISH,RX" ;vfah 28 D ^DIC K DIC ;vfah 29 S PSOZAF=+Y ;vfah 30 I $P(^PSRX(RX,"OR1"),"^",5)=$G(PSOZAF) W $C(7),!,"Cannot Reprint Labels for Autofinished Rxs" D ULR,KILL Q ;vfah 31 I $P(^PSRX(RX,"STA"),"^")=14 W $C(7),!,"Cannot Reprint! Discontinued by Provider." D ULR,KILL Q 32 I $P(^PSRX(RX,"STA"),"^")=15 W $C(7),!,"Cannot Reprint! Discontinued due to editing." D ULR,KILL Q 33 I $P(^PSRX(RX,"STA"),"^")=16 W $C(7),!,"Cannot Reprint! Placed on HOLD by Provider." D ULR,KILL Q 34 I DT>$P(^PSRX(RX,2),"^",6) D D ULR,KILL G LRP 35 .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 36 ..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 37 S DFN=$P(PDA,"^",2) D DEM^VADPT I $P(VADM(6),"^",2)]"" D G LRP 38 .W $C(7),!!,$P(^DPT($P(PDA,"^",2),0),"^")_" Died "_$P(VADM(6),"^",2)_".",! 39 .S $P(^PSRX(RX,"STA"),"^")=12,PCOM="Patient Expired "_$P(VADM(6),"^",2),ST="C" D EN^PSOHLSN1(RX,"OD","",PCOM,"A") 40 .D ACT1,ULR,KILL 41 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 D ULR,KILL G LRP 42 I $G(X)'>0 G GOOD 43 S XX=$P($G(^PS(52.5,X,0)),U,7) I $G(XX)']"" G GOOD 44 I $G(XX)="Q" W !,"RX CAN NOT BE PRINTED using this option, use SUSPENSE FUNCTIONS Options." K X,XX D ULR,KILL G LRP 45 I $G(XX)="L" W !,"RX is being transmitted to the CMOP and can not be reprinted now." K X,XX D ULR,KILL G LRP 46 GOOD K X 47 I $D(^PS(52.4,DA)) W !,"Prescription is Non-Verified",!! D ULR,KILL G LRP 48 S DFN=$P(^PSRX(DA,0),"^",2) I $D(^PS(52.4,"AREF",DFN,DA)) W !,"Prescription is waiting for others to be verified",!! D ULR,KILL G LRP 49 I $G(PSODIV),$D(^PSRX(DA,2)),+$P(^(2),"^",9),+$P(^(2),"^",9)'=PSOSITE S PSPOP=0,PSPRXN=DA D CHK1^PSOUTLA I PSPOP D ULR,KILL G LRP 50 I STA=3 W !?3,"Prescription is on Hold" D ULR,KILL G LRP 51 I STA=4 W !?3,"Prescription is Pending Due to Drug Interactions" D ULR,KILL G LRP 52 I STA=12 W !?3,"Prescription is Discontinued" D ULR,KILL G LRP 53 I $G(^PS(55,"ASTALK",DFN)) W !,"Patient is a ScripTalk patient. Use ScripTalk label for prescription bottle.",! 54 D ICN^PSODPT(DFN) 55 S COPIES=$S($P(PDA,"^",18)]"":$P(PDA,"^",18),1:1) 56 K DIR S DIR("A")="Number of Copies? ",DIR("B")=COPIES,DIR(0)="N^1:99:0",DIR("?")="Enter the number of copies you want (1 TO 99)" 57 D ^DIR K DIR I $D(DIRUT) D ULR,KILL G LRP 58 S COPIES=Y 59 K DIR S DIR("A")="Print adhesive portion of label only? ",DIR(0)="Y",DIR("B")="No",DIR("?",1)="If entire label, including trailers are to print press RETURN for default." 60 S DIR("?")="Else if only bottle and mailing labels are to print enter Y or YES." D ^DIR K DIR I $D(DUOUT) D ULR,KILL G LRP 61 I $D(DIRUT) D ULR G KILL 62 S SIDE=Y 63 I $P(PSOPAR,"^",30),$$GET1^DIQ(59,PSOSITE_",",105,"I")=2.4 D 64 .I $S($P(PSOPAR,"^",30)=3:1,$P(PSOPAR,"^",30)=4:1,1:0),'$$GET1^DIQ(50,$P(PDA,"^",6),28,"I") Q 65 .K DIR,DIRUT S DIR("A")="Do you want to resend to Dispensing System Device",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR Q:$D(DIRUT) S PSODISP=$S(Y:0,1:1) 66 I $D(DIRUT) D ULR,KILL G LRP 67 D ACT I $D(DIRUT) D ULR,KILL G LRP 68 I $D(PCOM) D ULR,KILL G LRP 69 F I=1,2,4,6,7,9,13,16 S P(I)=$P(PDA,"^",I) 70 S P(6)=+P(6) I $D(^PSRX(DA,"TN")),^("TN")]"" S P(6)=^("TN") 71 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),! 72 I $P($G(^PSRX(DA,"SIG")),"^",2) S D=0 D K D,FSIG 73 .D FSIG^PSOUTLA("R",DA,75) F S D=$O(FSIG(D)) W !,FSIG(D) Q:'$O(FSIG(D)) 74 E D EN3^PSOUTLA1(DA,75) S D=0 F S D=$O(BSIG(D)) W !,BSIG(D) Q:'$O(BSIG(D)) 75 K D,BSIG 76 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 77 W ?25,$S($D(^VA(200,+P(16),0)):$P(^(0),"^"),1:"Unknown"),!,"# of Refills: "_$G(P(9)) 78 I $G(RX) D 79 .S RXRP(RX)=1_"^"_COPIES_"^"_SIDE 80 .I $G(PSODISP)=1 S RXRP(RX,"RP")=1 81 .S RXFL(RX)=0 F ZZZ=0:0 S ZZZ=$O(^PSRX(RX,1,ZZZ)) Q:'ZZZ S RXFL(RX)=ZZZ 82 D @$S($P($G(PSOPAR),"^",26):"^PSORXL",1:"Q^PSORXL") K PSPOP,PPL,COPIES,SIDE,REPRINT,PCOM,IOP,PSL,PSNP,ZZZ,RXFL(+$G(RX)) D ULR,KILL G LRP 83 ; 84 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) 85 D ^DIR K DIR Q:$D(DIRUT)!($D(DIROUT)) S (PCOM,PCOMX)=X 86 I '$D(PSOCLC) S PSOCLC=DUZ 87 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 88 S IR=0 F J=0:0 S J=$O(^PSRX(DA,"A",J)) Q:'J S IR=J 89 S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR 90 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 91 S:$P(^PSRX(DA,2),"^",15)&($G(ST)'="C") $P(^PSRX(DA,2),"^",14)=1 92 Q 93 ; 94 KILL K %,DIR,DUOUT,DTOUT,DIROUT,DIRUT,C,DA,DIC,I,J,JJJ,K,RX,RXF,X,Y,Z,ZD,DFN,P,PDA,PSPRXN,COPIES,SIDE,PPL,REPRINT,PSXSTAT,PSORPRX,PSOMSG D KVA^VADPT Q 95 ; 96 ULR ; 97 I $G(PSORPRX) D PSOUL^PSSLOCK(PSORPRX) 98 Q
Note:
See TracChangeset
for help on using the changeset viewer.
