Index: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOAFPTL.m
===================================================================
--- WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOAFPTL.m	(revision 613)
+++ WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOAFPTL.m	(revision 623)
@@ -1,223 +1,223 @@
-PSOAFPTL	;VFA/HMS autofinish print for laser printer ; 3/6/07 9:25pm
-	;;7.0;OUTPATIENT PHARMACY;**208**;DEC 1997;Build 41
-	; 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
+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
