Changeset 636 for FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOLBLN.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/PSOLBLN.m (modified) (4 diffs)

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

@@ -1 @@
-PSOLBLN ;BIR/RTR-NEW PRINTS LABEL ;11/18/92
- ;;7.0;OUTPATIENT PHARMACY;**16,36,71,107,110,117,135,233**;DEC 1997;Build 8
+PSOLBLN ;BIR/RTR-NEW PRINTS LABEL ; 3/11/07 1:56pm
+ ;;7.0;OUTPATIENT PHARMACY;**16,36,71,107,110,117,135,233,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
  ;External reference to ^PSDRUG supported by DBIA 221
  ;External reference to ^VA(200 supported by DBIA 224
@@ -19 +35 @@
  S TECH="("_$S($P($G(^PSRX(+$G(RX),"OR1")),"^",5):$P($G(^PSRX(+$G(RX),"OR1")),"^",5),1:$P(RXY,"^",16))_"/"_$S($G(VRPH)&($P(PSOPAR,"^",32)):VRPH,1:" ")_")"
  S PSZIP=$P(PS,"^",5) S PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
+ ;
+ I $G(PSOAFYN)="Y" G PSOAFPL1 ;vfah
+ ;
 L1 W ?3,"VAMC ",$P(PS,"^",7),", ",STATE,"  ",$G(PSOHZIP),?54,"VAMC ",$P(PS,"^",7),", ",STATE,"  ",$G(PSOHZIP),?102 W $S($D(REPRINT)&($G(PSOBLALL)):"(GROUP REPRINT)",$D(REPRINT):"(REPRINT)",1:"") W:$G(RXP) "(PARTIAL)"
  W !?3,$P(PS2,"^",2),"  ",$P(PS,"^",3),"-",$P(PS,"^",4),"   ",TECH,?54,$P(PS2,"^",2),"  ",$P(PS,"^",3),"-",$P(PS,"^",4),"   ",TECH,?102,$P(PS2,"^",2)," ",TECH," ",NOW
@@ -53 +72 @@
 L13 I $G(WARN)'="",'$G(PSOBLALL) I '$G(PSDFNFLG),'$G(PSOLAPPL) D WARN^PSOLBL2
  W @IOF
+ ;
+PSOAFPL1 I $G(PSOAFYN)="Y" D PSOAFP ;vfah
+ ;
 REP I COPIES>0 S SIDE=1 G ST
  D NOW^%DTC S NOW=% K %,%H,%I I $G(RXF)="" S RXF=0 F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I  S RXF=I
@@ -65 +87 @@
  .S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_"ROUTING="_$G(MW)_" (BAD ADDRESS)"_"^"_PDUZ
  S ^PSRX(RX,"TYPE")=0 K RXF,IR,FDA,NOW,I,PCOMH(RX)
+PSOAFPL2 I $G(PSOAFYN)="Y" G PSOAFPL3 ;vfah
  I $G(WARN)'="" I $G(PSDFNFLG)!($G(PSOLAPPL)) D ALLWARN^PSOLBLN1
  I $G(WARN)="" I $G(PSDFNFLG)!($G(PSOLAPPL)) D ALL^PSOLBLS
  I $G(PSOBLALL) D:$G(WARN)="" ALL^PSOLBLS D:$G(WARN)'="" ALLWARN^PSOLBLN1
  I '$D(PSSPND),$P(PSOPAR,"^",18) I $G(PSDFNFLG)!($G(PSOLAPPL))!($G(PSOBLALL)) D CHCK2^PSOTRLBL
+PSOAFPL3 ;vfah
  D:$G(PSOBLALL) TRAIL^PSOLBL2
 END ;
  I $D(RXFLX(RX)) S RXFL(RX)=$G(RXFLX(RX)) K RXFLX
+ ;
+ I '$D(REPRINT)&($G(PSOAFYN)="Y") D ^PSODISP ;vfah auto-release
+ ;
  D KILL^PSOLBL2 Q
+ ;
+ Q  ;vfah
+ ;
+PSOAFP ;Patient prescription print starts here;vfah
+ S PSOAFPRV=$P($G(^PSRX(RX,0)),"^",4)
+ S PSDU=$P($G(^PSDRUG($P($G(^PSRX(RX,0)),"^",6),660)),"^",8) ;vfah sets dispense units
+ I $G(VFASDD)="Y" S $P(^PSRX(RX,"RXFIN"),"^",1)="Y" ;Sets complex order flag in File#52
+ K VFASDD
+ ;
+AFFAX ;
+ I $G(REPRINT)'=1 D
+ .S LZ=0,STOP=0 F  S LZ=$O(^PSRX(RX,"PRC",LZ)) Q:'LZ!(STOP=1)  S LZZ=$P(^PSRX(RX,"PRC",LZ,0),"FAX: ",2) S LZZ=+LZZ I LZZ'=0 D
+ ..I $D(^DIZ(22900)) D
+ ...S DIC="^DIZ(22900,",DIC(0)="MOZ",X=LZZ
+ ...D ^DIC K DIC
+ ...I +Y'=-1 D
+ ....S PSOAFFXP=X
+ ....S PSOAFFXL=$P(Y,"^",2)
+ ....S ^PSRX(RX,"PRC",LZ,0)=$TR(^PSRX(RX,"PRC",LZ,0),":","+")
+ ....S STOP=1
+ ...I +Y=-1 D
+ ....S ^PSRX(RX,"PRC",LZ,0)=$TR(^PSRX(RX,"PRC",LZ,0),":","-")
+ K STOP,LZ,LZZ
+ I $G(REPRINT)=1 S PSOAFFXP=$G(PSOAFFXR)
+ I $G(PSOAFFXP)>1 G AFPTL
+ ;
+AFPTS I PSOLAP["STAR" D PRNT^PSOAFPTS
+ I PSOLAP["STAR" G AFKILL
+ I PSOLAP["STRL" D PRNT^PSOAFPT1
+ I PSOLAP["STRL" G AFKILL
+ ;
+AFPTL D BEGLP^PSOAFPTL
+ ;
+AFKILL K PSOAFPRV
+ I $G(REPRINT)'=1 D ^%ZISC