Changeset 636 for FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSODISP.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSODISP.m (modified) (5 diffs)

FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSODISP.m

@@ -1 +1 @@
 PSODISP ;BIR/SAB,PWC-MANUAL BARCODE RELEASE FUNCTION ;03/02/93
- ;;7.0;OUTPATIENT PHARMACY;**15,71,131,156,185,148,247,200**;DEC 1997;Build 7
+ ;;7.0;OUTPATIENT PHARMACY;**15,71,131,156,185,148,247,200,208**;DEC 1997;Build 39
+ ; Modified from FOIA VISTA,
+ ; Copyright (C) 2007 WorldVistA
+ ;
+ ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU General Public License as published by
+ ; the Free Software Foundation; either version 2 of the License, or
+ ; (at your option) any later version.
+ ;
+ ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU General Public License for more details.
+ ;
+ ; You should have received a copy of the GNU General Public License
+ ; along with this program; if not, write to the Free Software
+ ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  ;Reference to $$SERV^IBARX1 supported by DBIA 2245
  ;Reference to ^PSD(58.8 supported by DBIA 1036
@@ -14 +30 @@
  S Y=$G(^PS(59,PSOSITE,"IB")),PSOIBSS=$$SERV^IBARX1(+Y) I 'PSOIBSS D IBSSR^PSOUTL I 'PSOIBFL D   G EXIT
  .W $C(7),!!,"The IB SERVICE/SECTION defined in your site parameter file is not valid.",!,"You will not be able to release any medication until this is corrected!",!
-AC1 W !! S PSIN=+$P($G(^PS(59.7,1,49.99)),"^",2)
- S DIC("S")="I $D(^XUSEC(""PSORPH"",+Y))",DIC("A")="Enter PHARMACIST: ",DIC="^VA(200,",DIC(0)="QEAM" D ^DIC G:"^"[X EXIT K DIC G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!(Y=-1) EXIT S PSRH=+Y
+AC1 I $G(PSOAFYN)'="Y" W !! S PSIN=+$P($G(^PS(59.7,1,49.99)),"^",2) ;vfah - VOE
+ I $G(PSOAFYN)="Y" S PSIN=+$P($G(^PS(59.7,1,49.99)),"^",2) ;vfah - VOE
+ I $G(PSOAFYN)'="Y" S DIC("S")="I $D(^XUSEC(""PSORPH"",+Y))",DIC("A")="Enter PHARMACIST: ",DIC="^VA(200,",DIC(0)="QEAM" D ^DIC G:"^"[X EXIT K DIC G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!(Y=-1) EXIT S PSRH=+Y ;vfah - VOE
+ I $G(PSOAFYN)="Y" S PSRH=DUZ,PSZAR="0" ;vfah - VOE
  ;check for Drug Acct background job K8 & K7.1
  S X="PSA IV ALL LOCATIONS",DIC(0)="MZ",DIC=19.2 D ^DIC I Y=-1 K DIC,X,Y G BC
@@ -25 +43 @@
  K PSA,DIC,DA,X,Y,DIQ
 BC ;
+ I $G(PSOAFYN)="Y",$G(PSZAR)="1" Q  ;vfah - VOE
  K MAN I $G(RXP),$D(DISGROUP),$D(BINGNAM),($D(BINGDIV)!$D(BNGPDV)!$D(BNGRDV)),($D(BINGRO)!$D(BINGRPR)) D REL^PSOBING1 K BINGNAM,BINGDIV,BINGRO,BINGRPR,BNGPDV,BNGRDV
- Q:$G(POERR)  W !! K CMOP,ISUF,DIR,LBL,LBLP S DIR("A")="Enter/Wand PRESCRIPTION number",DIR("?")="^D HELP^PSODISP",DIR(0)="FO" D ^DIR
+ I $G(PSOAFYN)'="Y" Q:$G(POERR)  W !! K CMOP,ISUF,DIR,LBL,LBLP S DIR("A")="Enter/Wand PRESCRIPTION number",DIR("?")="^D HELP^PSODISP",DIR(0)="FO" D ^DIR ;vfah - VOE
+ I $G(PSOAFYN)="Y" S X=RXN,PSZAR="1" ;vfah - VOE
  I $D(DIRUT)!($D(DTOUT))!($D(DUOUT)) K DIRUT,DTOUT,DUOUT G AC1
  I X'["-" D BCI W:'$G(RXP) !,"INVALID PRESCRIPTION NUMBER" G:'$G(RXP) BC S MAN=1 G BC1
@@ -62 +82 @@
  .I $$MANREL^PSOBPSUT(RXP,0,$G(PSOPID))="^" K LBLP Q
  .;
- .S:$D(^PSDRUG(QDRUG,660.1)) ^PSDRUG(QDRUG,660.1)=^PSDRUG(QDRUG,660.1)-QTY
+ .S:$D(^PSDRUG(QDRUG,660.1))&($G(PSOAFYN)'="Y") ^PSDRUG(QDRUG,660.1)=^PSDRUG(QDRUG,660.1)-QTY ;vfah - VOE
  .D NOW^%DTC S DIE="^PSRX(",DA=RXP,DR="31///"_%_";23////"_PSRH_";32.1///@;32.2///@",PSODT=% D ^DIE K DIE,DR,DA,LBL
  .;
@@ -78 +98 @@
  N BFILL S BFILL=0
  S PSOCPRX=$P(^PSRX(RXP,0),"^") D CP^PSOCP
- W !?7,"Prescription Number "_$P(^PSRX(RXP,0),"^")_" Released"
+ I $G(PSOAFYN)'="Y" W !?7,"Prescription Number "_$P(^PSRX(RXP,0),"^")_" Released" ;vfah - VOE
  ;initialize bingo board variables
  I $G(LBLP),$P(^PSRX(RXP,0),"^",11)["W" S BINGRO="W",BINGNAM=$P(^PSRX(RXP,0),"^",2),BINGDIV=$P(^PSRX(RXP,2),"^",9)