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

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

@@ -1 @@
-PSORXL ;BHAM ISC/SAB - action to be taken on prescriptions ;03/01/96  9:35
- ;;7.0;OUTPATIENT PHARMACY;**8,21,24,32,47,135,148**;DEC 1997
- ;External reference to File #50 supported by DBIA 221
- ;External references CHPUS^IBACUS and TRI^IBACUS supported by DBIA 2030
+PSORXL ;BHAM ISC/SAB - action to be taken on prescriptions ;3/13/07  19:21
+ ;;7.0;OUTPATIENT PHARMACY;**8,21,24,32,47,135,148,208**;DEC 1997;Build 39
+ ; Modified from FOIA VistA
+ ; Copyright (C) GNU GPL 2007 WorldVistA
+ ;
+ ;Ext ref to File #50 supported by DBIA 221
+ ;Ext refs CHPUS^IBACUS and TRI^IBACUS supported by DBIA 203
  I $G(PSOTRVV),$G(PPL) S PSORX("PSOL",1)=PPL K PPL
  N SLBL,PSOSONE,PSOKLRXS
  S:'$G(PPL) PPL=$G(PSORX("PSOL",1)) G:$P(PSOPAR,"^",26) P
-LBL W !! S DIR("A",1)="Label Printer: "_$S($G(SUSPT):PSLION,1:$G(PSOLAP))
+LBL I $G(PSOAFYN)'="Y" W !! S DIR("A",1)="Label Printer: "_$S($G(SUSPT):PSLION,1:$G(PSOLAP))
  S DIR("A")="LABEL: QUEUE/CHANGE PRINTER"_$S($P(PSOPAR,"^",23):"/HOLD",1:"")_$S($P(PSOPAR,"^",24):"/SUSPEND",1:"")_$S($P(PSOPAR,"^",26):"/LABEL",1:"")_" or '^' to bypass "
  S DIR("?",1)="Enter 'Q' to queue labels to print",DIR("?")="Enter '^' to bypass label functions",DIR("?",4)="Enter 'S' to suspend labels to print later"
@@ -12 +15 @@
  S DIR("?",5)="Enter 'C' to select another label printer"
  S:$P(PSOPAR,"^",26) DIR("?",5)="Enter 'L' to print labels without queuing"
-TRI ;Tricare
+TRI ;
  S X="IBACUS" X ^%ZOSF("TEST") K X I '$T G PASS
  I '$$TRI^IBACUS() G PASS
@@ -29 +32 @@
  I '$D(^TMP($J,"PSOBILL")) K ^TMP($J,"PSONOB") G PASS
  I '$D(^TMP($J,"PSONOB")),$D(^TMP($J,"PSOBILL")) S (Y,LBL)="H" G H1
- ;If some Rx's are billable, and some are not
+ ;
 SETP K PSORX("PSOL"),PPL S VVCT=1 F VV=0:0 S VV=$O(^TMP($J,$S($G(PSTRIVAR):"PSONOB",1:"PSOBILL"),VV)) Q:'VV  S TRIRX=^TMP($J,$S($G(PSTRIVAR):"PSONOB",1:"PSOBILL"),VV) I +TRIRX D
  .I $G(PSORX("PSOL",1))="" S PSORX("PSOL",1)=TRIRX_"," Q
@@ -37 +40 @@
  K ^TMP($J,"PSONOB") S PPL=$G(PSORX("PSOL",1))
 PASS ;
- I $E($G(DIR("A")),1,6)'="LABEL:" D RESDIR^PSOCPTRI
- S DIR(0)="SA^P:PROFILE;Q:QUEUE;C:CHANGE PRINTER"_$S($P(PSOPAR,"^",23):";H:HOLD",1:"")_$S($P(PSOPAR,"^",24):";S:SUSPENSE",1:"")_$S($P(PSOPAR,"^",26):";L:PRINT",1:""),DIR("B")="Q" D ^DIR D  G:$D(DIRUT)!($D(DUOUT)) EX
- .I $D(DIRUT)!($D(DUOUT)) D AL^PSOLBL("UT") I $G(PSOEXREP) S PSOEXREX=1
- .I $G(PSOPULL) I $D(DIRUT)!($D(DUOUT)) S PSOQFLAG=1
+ I $G(PSOAFYN)'="Y" I $E($G(DIR("A")),1,6)'="LABEL:" D RESDIR^PSOCPTRI
+ I $G(PSOAFYN)'="Y" S DIR(0)="SA^P:PROFILE;Q:QUEUE;C:CHANGE PRINTER"_$S($P(PSOPAR,"^",23):";H:HOLD",1:"")_$S($P(PSOPAR,"^",24):";S:SUSPENSE",1:"")_$S($P(PSOPAR,"^",26):";L:PRINT",1:""),DIR("B")="Q" D ^DIR D  G:$D(DIRUT)!($D(DUOUT)) EX
+ .I $G(PSOAFYN)'="Y" I $D(DIRUT)!($D(DUOUT)) D AL^PSOLBL("UT") I $G(PSOEXREP) S PSOEXREX=1
+ .I $G(PSOAFYN)'="Y" I $G(PSOPULL) I $D(DIRUT)!($D(DUOUT)) S PSOQFLAG=1
+ I $G(PSOAFYN)="Y" S PSOLAP=$G(^SC(+ORL,"AFRXCLINPRNT"))
+ I $G(PSOAFYN)="Y" I PSOLAP="" S DIRUT="^" G:$D(DIRUT)!($D(DUOUT)) EX
+ I $G(PSOAFYN)="Y" S PSOLAP=$P(^%ZIS(1,PSOLAP,0),"^",1)
  S:$G(PSOBEDT) NOPP=Y
  I $G(Y)="C" K PSOCLBL,%ZIS("B") S PSOCLBL=1 D @$S('$D(PSOPAR):"^PSOLSET",1:"PLBL^PSOLSET") K PSOCLBL G LBL
@@ -57 +63 @@
  D ^%ZISC S PSL=0
 QLBL I $G(PSXSYS),('$G(RXLTOP)),('$G(PSOEXREP)) D RXL^PSOCMOP G:'$G(PPL) D1
- ;
  ;- Submitting list of Rx to ECME for DUR/79 REJECT check and possible submission to 3rd Pary Payer
- D ECME^PSORXL1
+ I $G(PSOAFYN)'="Y" D ECME^PSORXL1 ;vfah
  ;
  S ZTRTN="DQ^PSOLBL",ZTIO=$S($G(SUSPT):PSLION,1:PSOLAP),ZTDESC="Outpatient Pharmacy "_$S($G(SUSPT):"SUSPENSE ",$G(DG):"DRUG INTERACTION ",1:"")_"LABELS OUTPUT ROUTINE",ZTDTH=$S($G(PSOTIME):PSOTIME,1:$H),PDUZ=DUZ
  F G="PPL1","PSOSYS","DFN","PSOPAR","PDUZ","PCOMX",$S($G(SUSPT):"PFION",1:"PSOLAP"),"PPL","PSOSITE","RXY","COPIES","SIDE","PSOSUSPR","PSOBARS","PSOBAR1","PSOBAR0","PSODELE","PSOPULL","PSTAT","PSODBQ","PSOEXREP","PSOTREP" S:$D(@G) ZTSAVE(G)=""
+ S ZTSAVE("PSOAFDFN")="",ZTSAVE("PSOAFDUZ")="",ZTSAVE("PSOAFYN")="",ZTSAVE("PSOAFPAT")="",ZTSAVE("PSOAFPNM")="",ZTSAVE("VFASDD")="",ZTSAVE("ORL")="" ;vfah
  S ZTSAVE("PSORX(")="",ZTSAVE("RXRP(")="",ZTSAVE("RXPR(")="",ZTSAVE("RXRS(")="",ZTSAVE("RXFL(")="",ZTSAVE("PCOMH(")=""
  D ^%ZISC,^%ZTLOAD K:$G(PSOSONE) RXRS W:$D(ZTSK)&('$G(SUSPT))&('$G(PSOEXREP)) !!,"LABEL(S) QUEUED TO PRINT",!!