224 lines
6.4 KiB
Mathematica
224 lines
6.4 KiB
Mathematica
PSOAFPTL ;VFA/HMS autofinish print for laser printer ; 3/6/07 9:25pm
|
|
;;7.0;OUTPATIENT PHARMACY;**208**;DEC 1997;Build 39
|
|
; 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
|
|
BEGLP ;
|
|
U IO ;hms fax stuff
|
|
;
|
|
F DR=1:1 Q:$G(SGY(DR))="" S SN=19+DR D
|
|
.S AFSIG(SN)=$G(SGY(DR))
|
|
S SIGL=DR-1
|
|
;
|
|
;CHECK FOR ES
|
|
S AFESFLAG=$P($G(^PS(59,PSOSITE,"RXFIN")),"^",3)
|
|
S AFORD=$P(^PSRX(RX,"OR1"),"^",2)
|
|
I $G(AFESFLAG)="Y" D
|
|
.S AFES=$P($G(^OR(100,AFORD,8,1,0)),"^",4)
|
|
.I $G(AFES)=1 S AFESYN="Y"
|
|
.I $G(AFESYN)="Y" S AFESIGN=$P($G(^OR(100,AFORD,8,1,0)),"^",5)
|
|
;
|
|
;CHECK FOR SCHEDULE II WET SIGNATUIRE
|
|
S AFWET2=$P($G(^PS(59,PSOSITE,"RXFIN")),"^",6)
|
|
S AFDEA=$P(^PSDRUG($P($G(^PSRX(RX,0)),"^",6),0),"^",3)
|
|
;
|
|
I $G(AFWET2)="Y"&($G(AFDEA)["2") S AFESFLAG="" ;Turns off ES for Sch IIs if wet sig for IIs set in File#59
|
|
I $G(AFWET2)="Y"&($G(AFDEA)["2") S AFESYN=""
|
|
;
|
|
;Get Synonym
|
|
S AFS=0,DONE="N",AFSYN="" F L=1:1 S AFS=$O(^PSDRUG($P($G(^PSRX(RX,0)),"^",6),1,AFS)) Q:AFS=""!(DONE="Y") D
|
|
.I $P(^PSDRUG($P($G(^PSRX(RX,0)),"^",6),1,AFS,0),"^",3)="0" D
|
|
..S AFSYN=$P($G(^PSDRUG($P($G(^PSRX(RX,0)),"^",6),1,AFS,0)),"^",1),DONE="Y"
|
|
K DONE
|
|
;
|
|
FAX ;
|
|
K AFFAX
|
|
S FAXNUM=$G(PSOAFFXP) ;PSOAFFXP from PSOLBLN
|
|
S FAXLCNUM=$G(PSOAFFXL)_"@"_FAXNUM
|
|
S FAXSER=$P($G(^PS(59,PSOSITE,"RXFIN")),"^",10)
|
|
I $G(FAXNUM)'=""&(FAXSER'="") D
|
|
. S AFFAX="Y"
|
|
I IO["AFFAX"!($G(AFFAX)="Y") D
|
|
.D NOW^%DTC
|
|
.S FAXDATE=$P(%,".",1)_"Z"_$P(%,".",2)
|
|
.S FAXJOB=RX_"Z"_DFN_"Z"_FAXDATE
|
|
.D OPEN^%ZISH("HFSFAX",FAXSER,FAXJOB_"+"_FAXLCNUM_".TXT","A")
|
|
.S AFFAX="Y"
|
|
.U IO
|
|
;
|
|
;Checks to see if 1st 3 lines should print
|
|
S PSOAFPFT=$P($G(^PS(59,PSOSITE,"RXFIN")),"^",9)
|
|
;
|
|
EN1 S OFF=$P(PS,"^",1)
|
|
W $S(PSOAFPFT="N":"",1:OFF)
|
|
;
|
|
S OFFAD=$P(PS,"^",7)_","_STATE_" "_$G(PSOHZIP)
|
|
W !
|
|
W $S(PSOAFPFT="N":"",1:OFFAD)
|
|
;
|
|
S OFFTEL=$P(PS,"^",3)_"-"_$P(PS,"^",4)
|
|
W !
|
|
W $S(PSOAFPFT="N":"",1:OFFTEL)
|
|
;
|
|
S OFFFREE=$P($G(^PS(59,PSOSITE,"RXFIN")),"^",4)
|
|
W !,OFFFREE
|
|
;
|
|
W !,"---------------------------------------------------------------",!
|
|
;
|
|
W !,"Rx for: "
|
|
;
|
|
D 6^VADPT,PID^VADPT
|
|
S PSOAFPTI=$S(DUZ("AG")="V":$E($G(VA("PID")),5,12),1:$G(VA("PID")))
|
|
S AFPNAM=PNM_" "_$G(PSOAFPTI)
|
|
W AFPNAM
|
|
;
|
|
S AFPADD1=$G(VAPA(1))
|
|
W !," ",AFPADD1
|
|
;
|
|
S AFPADD2=$G(ADDR(2))
|
|
W !," ",AFPADD2
|
|
;
|
|
S AFPADD3=$G(ADDR(3))
|
|
W !," ",AFPADD3
|
|
;
|
|
S AFPADD4=$G(ADDR(4))
|
|
W !," ",AFPADD4
|
|
;
|
|
W !,"---------------------------------------------------------------",!
|
|
S AFDRUG=DRUG
|
|
W !,AFDRUG
|
|
;
|
|
S SYNFLAG=$P($G(^PS(59,PSOSITE,"RXFIN")),"^",5)
|
|
I SYNFLAG="Y"&(AFSYN'="") D
|
|
.W !,"Also known as: "
|
|
.W AFSYN
|
|
;
|
|
I $P($G(^PSRX(RX,"RXFIN")),"^",1)="Y" S VFASDD="Y"
|
|
I $G(VFASDD)="Y" D
|
|
.W !,"Pharmacy may choose strength(s) of drug to meet requirements of directions"
|
|
;
|
|
;
|
|
SIG S SN=19
|
|
W !
|
|
F L=1:1:SIGL S SN=SN+1 W !,AFSIG(SN)
|
|
W !
|
|
;
|
|
W !," Dispense: "
|
|
S AFDISP=$G(QTY)_" "_$G(PSDU)
|
|
W AFDISP
|
|
;
|
|
I $G(VFASDD)="Y" W " Pharmacy to adjust qty for # of days"
|
|
;
|
|
W !,"Days Supply: "
|
|
S VFADAYS=$G(DAYS)
|
|
W VFADAYS
|
|
;
|
|
W !," Refill(s): "
|
|
S AFRF=$P(RXY,"^",9)
|
|
W AFRF
|
|
;
|
|
W !," Issue Date: "
|
|
W DATE
|
|
;
|
|
;Print Diagnosis
|
|
I $P($G(^PS(59,PSOSITE,"RXFIN")),"^",8)="Y" D
|
|
DIAG .W !," Diagnosis:"
|
|
.S AFICD9="None",AFICD="Not Available"
|
|
.I $D(^OR(100,AFORD,5.1,0)) D
|
|
..S AFORL=0
|
|
..F L=1:1 S AFORL=$O(^OR(100,AFORD,5.1,AFORL)) Q:AFORL="B"!(AFORL=0)!(AFORL="") D
|
|
...S AFORIN=$P($G(^OR(100,AFORD,5.1,AFORL,0)),"^",1)
|
|
...I AFORIN>"" D
|
|
....S AFICD9=$P($G(^ICD9(AFORIN,0)),"^",1)
|
|
....S AFICD=$P($G(^ICD9(AFORIN,0)),"^",3)
|
|
....W ?13,AFICD9,?23,AFICD
|
|
.I AFICD9="None" W ?13,AFICD9,?23,AFICD
|
|
;
|
|
;Prints DOB
|
|
I $P($G(^PS(59,PSOSITE,"RXFIN")),"^",7)="Y" D
|
|
.S PSOAFDOB=$P($G(VADM(3)),"^",2)
|
|
.W !," DOB: "_PSOAFDOB,!
|
|
;
|
|
;Prints Provider Comments
|
|
;W "MD Comments:"
|
|
K ^UTILITY($J,"W") S PSNACNT=1,DIWL=0,DIWR=48,DIWF="",(PSSIXFL,PSSEVFL)=0 F ZZ=0:0 S ZZ=$O(^PSRX(RX,"PRC",ZZ)) Q:'ZZ I $D(^(ZZ,0)) S X=^(0) D ^DIWP
|
|
;D ^DIWW
|
|
I $D(^UTILITY($J,"W")) D
|
|
.W "MD Comments:"
|
|
.F ZZ=0:0 S ZZ=$O(^UTILITY($J,"W",DIWL,ZZ)) Q:'ZZ I $D(^(ZZ,0)) W ?13,^(0),!
|
|
K ^UTILITY($J,"W")
|
|
;
|
|
SIGN ;Prints DEA if it exists-if no DEA# prints VA# if it exists
|
|
I $G(AFESFLAG)="Y" D
|
|
.I $G(AFESYN)="Y" D
|
|
..S AFDEA=$$GET1^DIQ(200,AFESIGN,53.2,"I")
|
|
..I AFDEA="" D
|
|
...S AFDEA=$$GET1^DIQ(200,AFESIGN,53.3,"I")
|
|
..S AFESIGNN=$$GET1^DIQ(200,AFESIGN,.01,"I")
|
|
..S AFSIGN=$G(AFESIGNN)_" "_AFDEA
|
|
;
|
|
SIGN1 I $G(AFESFLAG)'="Y" D
|
|
.W !!!,"Signature:_________________________________________________"
|
|
.;vfah prints DEA if it exists-if no DEA# prints VA# if it exists
|
|
.S AFDEA=$$GET1^DIQ(200,PSOAFPRV,53.2,"I")
|
|
.I AFDEA="" D
|
|
..S AFDEA=$$GET1^DIQ(200,PSOAFPRV,53.3,"I")
|
|
.S AFSIGN=" "_$G(PHYS)_" "_AFDEA
|
|
;
|
|
SIGNP I $G(AFESYN)="Y" S AFSIGN="Signed: /ES/"_AFSIGN
|
|
W !,AFSIGN
|
|
;
|
|
K AFESYN,AFESIGN,AFESIGNN
|
|
;
|
|
W !!,"Must write BRAND NECESSARY to dispense brand drug"
|
|
;
|
|
S AFPTIM=$S($D(REPRINT):"Re-Printed on: ",1:"Printed on: ")
|
|
W !!,AFPTIM
|
|
;
|
|
D NOW^%DTC S Y=% X ^DD("DD")
|
|
S AFPRNDT=Y_" ("_RX_")"
|
|
W AFPRNDT
|
|
;
|
|
I IO["AFFAX"!($G(AFFAX)="Y") D
|
|
.S FAXFROM=$P($G(^PS(59,PSOSITE,"RXFIN")),"^",11)
|
|
.W !!,"Faxed from: ",FAXFROM," ON ",Y
|
|
;
|
|
I $D(REPRINT)&($G(PSOCKHN)'=",") W @IOF
|
|
;
|
|
K VFASDD
|
|
;
|
|
I IO["AFFAX"!($G(AFFAX)="Y") D CLOSE^%ZISH("HFSFAX") ;HMS CLOSE HFS FILE
|
|
;
|
|
I $G(REPRINT)'=1 D
|
|
.I IO["AFFAX"!($G(AFFAX)="Y") D
|
|
..S PSOLAP=$G(^SC(+ORL,"AFRXCLINPRNT"))
|
|
..S PSOLAP=$P(^%ZIS(1,PSOLAP,0),"^",1)
|
|
..S IOP=PSOLAP D ^%ZIS
|
|
..U IO
|
|
;
|
|
ACT ;Set activity log if faxed
|
|
I IO["AFFAX"!($G(AFFAX)="Y") D
|
|
.S (X,PCOM,PCOMX)="Faxed to: "_PSOAFFXP_" on "_Y
|
|
.I '$D(PSOCLC) S PSOCLC=DUZ
|
|
ACT1 .S RXF=0 F J=0:0 S J=$O(^PSRX(RX,1,J)) Q:'J S RXF=J S:J>5 RXF=J+1
|
|
.S IR=0 F J=0:0 S J=$O(^PSRX(RX,"A",J)) Q:'J S IR=J
|
|
.S PSOAFPTZ=$S($D(REPRINT):"W",1:"AFFAX")
|
|
.S IR=IR+1,^PSRX(RX,"A",0)="^52.3DA^"_IR_"^"_IR
|
|
.D NOW^%DTC S ^PSRX(RX,"A",IR,0)=%_"^"_PSOAFPTZ_"^"_DUZ_"^"_RXF_"^"_PCOM K PC,IR,PS,PCOM,XX,%,%H,%I,RXF
|
|
;
|
|
K PSOAFFXP,PSOAFFXL
|
|
;
|
|
Q
|