source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOAFPTL.m@ 1464

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