PSOHLSG1 ;BIR/LC - Build HL7 Segments ; 11/4/04 2:56pm
;;7.0;OUTPATIENT PHARMACY;**10,26,30,56,70,139,152,385**;DEC 1997;Build 27
;HLFNC supp. by DBIA 10106
;PSNAPIS supp. by DBIA 2531
;VASITE supp. by DBIA 10112
;VADPT supp. by DBIA 10061
;EN^DIQ1 supp. by DBIA 10015
;EN^VAFHLPID supp. by DBIA 263
;EN^VAFHLZTA supp. by DBIA 758
;PSDRUG supp. by DBIA 221
;PS(50.7 supp. by DBIA 2223
;PS(50.606 supp. by DBIA 2174
;PSNDF(50.6 supp. by DBIA 2195
;PS(51.2 supp. by DBIA 2226
;PS(55 supp. by DBIA 2228
;PS(50.607 supp. by DBIA 2221
;DIC(5 supp. by DBIA 10056
;DPT supp. by DBIA 3097
;SC supp. by DBIA 10040
;VA(200 supp. by DBIA 10060
START ;
D PID(.PSI),ORC(.PSI),RXE(.PSI),NTE(.PSI),RXR(.PSI),ZRL(.PSI)
D ZAL^PSOHLSG2(.PSI),ZML^PSOHLSG2(.PSI),ZSL^PSOHLSG2(.PSI)
Q
PID(PSI) ;patient ID segment
Q:'$D(DFN)!$D(PAS)
S HLFS=HL1("FS"),HLECH=HL1("ECH"),HLQ=HL1("Q"),HLVER=HL1("VER")
N X1,X2,D1,D2
S X1=$$EN^VAFHLPID(DFN,"3,5,8,11,13,19,",1)
S X2=$$EN^VAFHLZTA(DFN,"2,3,4,5,6,7,",1)
;if temp. address is active then use it
I $P(X2,HLFS,3) D
.S:$P(X2,HLFS,4) D1=$$FMDATE^HLFNC($P(X2,HLFS,4))
.S:$P(X2,HLFS,5) D2=$$FMDATE^HLFNC($P(X2,HLFS,5))
.I $G(D1),$G(D2),(DT'<D1&(DT'>D2)) D
..S:$P(X2,HLFS,6)]"" $P(X1,HLFS,12)=$P(X2,HLFS,6),$P(X1,HLFS,14)=$P(X2,HLFS,8)
S ^TMP("PSO",$J,PSI)=$E(X1,1,245)
S PSI=PSI+1,PAS=1
Q
ORC(PSI) ;common order segment
Q:'$D(DFN)
N ORC
S:$G(FP)="F"&('$G(FPN)) FDT=$P(^PSRX(IRXN,2),"^",2),EXDT=$S($P(^(2),"^",6):$P(^(2),"^",6),1:"")
S:$G(FP)="F"&('$G(FPN)) EBY=$P(^PSRX(IRXN,0),"^",16),PVDR=$P(^(0),"^",4),EFDT=$P(^(2),"^",2)
S:$G(FP)="F"&($G(FPN)) FDT=$P(^PSRX(IRXN,1,FPN,0),"^"),EXDT=$S($P(^(0),"^",15):$P(^(0),"^",15),1:"")
S:$G(FP)="F"&($G(FPN)) EBY=$S($P(^PSRX(IRXN,1,FPN,0),"^",5):$P(^(0),"^",5),1:$P(^(0),"^",7)),PVDR=$P(^(0),"^",17),EFDT=$P(^(0),"^",8)
S:$G(FP)="P" FDT=$P(^PSRX(IRXN,"P",FPN,0),"^"),PVDR=$P(^(0),"^",17),EXDT=$S($P(^PSRX(IRXN,2),"^",6):$P(^(2),"^",6),1:"")
S:$G(FP)="P" EBY=$S($P(^PSRX(IRXN,"P",FPN,0),"^",5):$P(^(0),"^",5),1:$P(^(0),"^",7)),PVDR=$P(^(0),"^",17),EFDT=$P(^(0),"^",8)
S EBY1=$P(^VA(200,EBY,0),"^"),PVDR1=$P(^VA(200,PVDR,0),"^")
S FDT=$$HLDATE^HLFNC(FDT,"DT") S:$G(EXDT) EXDT=$$HLDATE^HLFNC(EXDT,"DT"),EFDT=$$HLDATE^HLFNC(EFDT,"DT")
S EBY1=$$HLNAME^HLFNC(EBY1),PVDR1=$$HLNAME^HLFNC(PVDR1)
S ORC="ORC"_FS_"NW"_FS_IRXN_CS_"OP7.0"_FS_FS_FS_FS_FS_CS_CS_CS
S ORC=ORC_FDT_CS_EXDT_FS_FS_FS_EBY_CS_EBY1_FS_FS
S ORC=ORC_PVDR_CS_PVDR1_FS_FS_FS_EFDT_FS_CS_CS_CS_CS_"NEW"_FS_FS_FS_FS_FS_$S($$STATUS^PSOBPSUT(IRXN,$G(RXFL(IRXN)))]"":"VA5",1:"")
S ^TMP("PSO",$J,PSI)=ORC
S PSI=PSI+1
K EBY,EBY1,EFDT,EXDT,FDT,PVDR,PVDR1
Q
RXE(PSI) ;pharmacy encoded order segment
Q:'$D(DFN)
N RXE
S PSND1=$P($G(^PSDRUG(IDGN,"ND")),"^"),PSND2=$P($G(^("ND")),"^",2),PSND3=$P($G(^("ND")),"^",3)
K PSOXN,PSOXN2
I PSND1,PSND3 D
.I $T(^PSNAPIS)]"" S PSOXN=$$DFSU^PSNAPIS(PSND1,PSND3),UNIT=$P($G(PSOXN),"^",6) S PSOXN=$P($G(PSOXN),"^",5) S PSOXN2=$$PROD2^PSNAPIS(PSND1,PSND3) Q
.S PSOXN2=$G(^PSNDF(PSND1,5,PSND3,2))
.S PRODUCT=$G(^PSNDF(PSND1,5,PSND3,0))
.I $G(PRODUCT)'="" S PSOXN=+$P($G(^PSNDF(PSND1,2,+$P(PRODUCT,"^",2),3,+$P(PRODUCT,"^",3),4,+$P(PRODUCT,"^",4),0)),"^"),UNIT=$P($G(^PS(50.607,PSOXN,0)),"^")
S RXE="RXE"_FS_""""""_FS_$S($P($G(^PSDRUG(IDGN,"ND")),"^",10)'="":$P(^("ND"),"^",10),($G(PSND1)&$G(PSND3)):$P($G(PSOXN2),"^",2),1:"""""")_CS_PSND2_CS_"PSNDF"
S RXE=RXE_CS_PSND1_"."_PSND3_"."_$G(IDGN)_CS_$P($G(^PSDRUG(IDGN,0)),"^")_CS_"99PSD"_FS_""""""_FS_FS
I $G(PSOXN)="" S PSOXN=""""""
S RXE=RXE_CS_CS_CS_PSOXN_CS_$S($G(UNIT)'="":$G(UNIT),1:"""""")_CS_"99PSU"_FS
K PSOXN,PSOXN2
S POIPTR=$P($G(^PSRX(IRXN,"OR1")),"^") I POIPTR S PODOSE=$P($G(^PS(50.7,POIPTR,0)),"^",2),PODOSENM=$G(^PS(50.606,PODOSE,0))
I '$G(POIPTR) S PODOSE=$P($G(^PS(50.7,$P($G(^PSDRUG(IDGN,2)),"^"),0)),"^",2),PODOSENM=$G(^PS(50.606,PODOSE,0))
;S RXE=RXE_CS_CS_CS_$S($G(PODOSE):PODOSE,1:"""""")_CS_$S($G(PODOSENM):PODOSENM,1:"""""")_CS_"99PSF"_FS_FS_FS_FS_FS_CS_$P(^PSDRUG(IDGN,660),"^",8)_FS
S RXE=RXE_CS_CS_CS_PODOSE_CS_PODOSENM_CS_"99PSF"_FS_FS_FS_FS_FS_CS_$P($G(^PSDRUG(IDGN,660)),"^",8)_FS
S:$G(FP)="F"&('$G(FPN)) VPHARMID=$P(^PSRX(IRXN,2),"^",3)
S:$G(FP)="F"&($G(FPN)) VPHARMID=$S($P(^PSRX(IRXN,1,FPN,0),"^",5)'="":$P(^(0),"^",5),1:$P(^PSRX(IRXN,2),"^",3))
S:$G(FP)="P" VPHARMID=$S($P(^PSRX(IRXN,"P",FPN,0),"^",5)'="":$P(^(0),"^",5),1:$P(^PSRX(IRXN,2),"^",3))
I '$G(VPHARMID) S VPHARMID="""""",VPHARM=""""""
I $G(VPHARMID) S VPHARM=$P(^VA(200,VPHARMID,0),"^"),VPHARM=$$HLNAME^HLFNC(VPHARM)
S NFLD=0,UU="" F S UU=$O(^PSRX(IRXN,1,UU)) Q:UU="" S:$D(^PSRX(IRXN,1,UU,0)) NFLD=NFLD+1
S NRFL=$P(^PSRX(IRXN,0),"^",9),RFRM=(NRFL-NFLD),DISPDT=$P(^PSRX(IRXN,3),"^"),DISPDT=$$HLDATE^HLFNC(DISPDT,"DT")
S RXE=RXE_NRFL_FS_FS_VPHARMID_CS_VPHARM_FS_$P(^PSRX(IRXN,0),"^")_FS_RFRM_FS_FS_DISPDT
S ^TMP("PSO",$J,PSI)=RXE
S PSI=PSI+1
K PSND1,PSND2,PSND3,PRODUCT,UNIT,PODOSE,PODOSENM,POIPTR,VPHARMID,VPHARM,NRFL,DISPDT,UU
Q
NTE(PSI) ;note segments
;
D NTE1^PSOHLSG2(.PSI)
D NTE2^PSOHLSG2(.PSI)
D NTE3^PSOHLSG2(.PSI)
D NTE4^PSOHLSG2(.PSI)
D NTE5^PSOHLSG2(.PSI)
D NTE6^PSOHLSG2(.PSI)
Q
RXR(PSI) ;pharmacy route segment
Q:'$D(DFN)
N RXR
S (PSROUTE,RTNAME)=""""""
F PSRTLP=0:0 S PSRTLP=$O(^PSRX(IRXN,"MEDR",PSRTLP)) Q:'PSRTLP D
.S PSROUTE=$P($G(^PSRX(IRXN,"MEDR",PSRTLP,0)),"^") I PSROUTE,$D(^PS(51.2,PSROUTE,0)) S RTNAME=$P(^PS(51.2,PSROUTE,0),"^")
S RXR="RXR"_FS_CS_CS_CS_$G(PSROUTE)_CS_$G(RTNAME)_CS_"99PSR"
S ^TMP("PSO",$J,PSI)=RXR
S PSI=PSI+1
K PSROUTE,RTNAME,PSRTLP
Q
;
ZRL(PSI) ;Rx label segment
Q:'$D(DFN)!('$D(PSOSITE))
N ZRL,ZRL1
S SITE=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
S ZRL="ZRL"_FS_$P(SITE,"^",6)_FS_$P(SITE,"^",2)_CS_$P(SITE,"^",7)_CS
S ZRL=ZRL_$S($D(^DIC(5,+$P(SITE,"^",8),0)):$P(^(0),"^",2),1:"UKN")_CS
S PSZIP=$P(SITE,"^",5) S PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
S ZRL=ZRL_PSOHZIP_FS_$P(SITE,"^",3)_"-"_$P(SITE,"^",4)_FS
S CLN=+$P(^PSRX(IRXN,0),"^",5),CLN1=$S($D(^SC(CLN,0)):$P(^(0),"^",2),1:"UNKNOWN")
S CSINER=$S($P(^PSRX(IRXN,3),"^",3):$P(^(3),"^",3),1:"""""")
S CSINER1=$S($G(CSINER):$P(^VA(200,CSINER,0),"^"),1:""""""),CSINER1=$$HLNAME^HLFNC(CSINER1)
S ZRL=ZRL_CLN_CS_CLN1_CS_"99PSC"_FS_CSINER_CS_CSINER1_FS
D 6^VADPT S ZRL=ZRL_$E($P(VADM(2),"^",2),5,11)_FS_$P(VADM(2),"^")_FS_$P($G(^PS(53,+$P($G(^PSRX(IRXN,0)),"^",3),0)),"^",2)_FS_$S($P($G(VAPA(10)),"^",2)]"":$P($G(VAPA(10)),"^",2),1:"""""")_FS
S:$G(FP)="F"&('$G(FPN)) MW=$P(^PSRX(IRXN,0),"^",11),FDT=$P(^(2),"^",2),QTY=$P(^(0),"^",7),DASPLY=$P(^(0),"^",8)
S:$G(FP)="F"&($G(FPN)) MW=$P(^PSRX(IRXN,1,FPN,0),"^",2),FDT=$P(^(0),"^"),QTY=$P(^(0),"^",4),DASPLY=$P(^(0),"^",10)
S:$G(FP)="P" MW=$P(^PSRX(IRXN,"P",FPN,0),"^",2),FDT=$P(^(0),"^"),QTY=$P(^(0),"^",4),DASPLY=$P(^(0),"^",10)
I MW="W" S MP=$S($G(^PSRX(IRXN,"MP")):$G(^("MP")),1:"""""")
S X=$S($D(^PS(55,DFN,0)):^(0),1:""),CAP=$P(X,"^",2)
S:MW="M" MP="""""",MW=$S($P(X,"^",3):"R",1:MW) S MW=$S(MW="M":"REGULAR MAIL",MW="R":"CERTIFIED MAIL",1:"""""")
I (($P(^PSRX(IRXN,"STA"),"^")>0)&($P(^("STA"),"^")'=2)&('$G(PSODBQ)))!'$G(^PSRX(IRXN,"IB")) S COPAY="NO COPAY"
E S COPAY="COPAY"
S ZRL=ZRL_MP_FS_COPAY_FS_$S($G(CAP):"NON-SAFETY",1:"SAFETY")_FS_$S($G(RFRM):"REFILLABLE",'$G(RFRM):"NON-REFILLABLE",1:"""""")_FS
S ZRL=ZRL_$S($G(RFRM)>1:RFRM_" Refills remain prior to",$G(RFRM)=1:"Last fill prior to",1:"""""")_FS_$S($E(MW)="W":"""""",1:MW)_FS
S NURSE=$S($P($G(^DPT(DFN,"NHC")),"^")="Y":1,$P($G(^PS(55,DFN,40)),"^"):1,1:0)
S ZRL=ZRL_$S($G(NURSE):"Mfg______Exp______",1:"""""")_FS_$S($G(FP)="P":"PARTIAL",1:"""""")_FS
S DATE=$$HLDATE^HLFNC(FDT) D NOW^%DTC S NOW=$$HLDATE^HLFNC(%,"TS")
K DIC,DR,DIQ S DA=$P($$SITE^VASITE(),"^") I DA D
.K PSOINST S DIC=4,DIQ(0)="I",DR=99,DIQ="PSOINST" D EN^DIQ1
.S PSOINST=PSOINST(4,DA,99,"I") K DIC,DA,DR,DIQ,PSOINST(4)
S DRUG=$$ZZ^PSOSUTL(IRXN),DEA=$P($G(^PSDRUG(+$P(^PSRX(IRXN,0),"^",6),0)),"^",3),WARN=$P($G(^(0)),"^",8)
S ZRL=ZRL_NOW_FS_DATE_FS_$S($G(NFLD):NFLD,1:"""""")_FS_DASPLY_FS_PSOINST_"-"_IRXN_FS_$S($G(WARN)'="":"DRUG WARNING "_$G(WARN),1:"""""")_FS_QTY
;COMPENSATE FOR $L(ZRL)>245
I $L(ZRL)>245 S LTH=$E($L(ZRL)/245,1) S:$L(ZRL)#245>0 LTH=LTH+1 F WW=1:1:LTH D
.S:WW=1 ST=1,EN=245 S:WW>1 ST=(ST+245),EN=(EN+245)
.S ZRL1=$E(ZRL,ST,EN)
.S:WW=1 ^TMP("PSO",$J,PSI)=ZRL1
.S:WW>1 ^TMP("PSO",$J,PSI,WW-1)=ZRL1
S:'$D(LTH) ^TMP("PSO",$J,PSI)=ZRL
S PSI=PSI+1
K SITE,PSZIP,PSOHZIP,CLN,CLN1,CSINER,CSINER1,MW,MP,NOW,QTY,CAP,DASPLY,COPAY,NURSE,DATE,DRUG,WARN,DEA,LTH,WW,ST,EN,VADM,VAPA,%,X,NFLD,RFRM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOHLSG1 8586 printed Apr 09, 2024@21:27:44 Page 2
PSOHLSG1 ;BIR/LC - Build HL7 Segments ; 11/4/04 2:56pm
+1 ;;7.0;OUTPATIENT PHARMACY;**10,26,30,56,70,139,152,385**;DEC 1997;Build 27
+2 ;HLFNC supp. by DBIA 10106
+3 ;PSNAPIS supp. by DBIA 2531
+4 ;VASITE supp. by DBIA 10112
+5 ;VADPT supp. by DBIA 10061
+6 ;EN^DIQ1 supp. by DBIA 10015
+7 ;EN^VAFHLPID supp. by DBIA 263
+8 ;EN^VAFHLZTA supp. by DBIA 758
+9 ;PSDRUG supp. by DBIA 221
+10 ;PS(50.7 supp. by DBIA 2223
+11 ;PS(50.606 supp. by DBIA 2174
+12 ;PSNDF(50.6 supp. by DBIA 2195
+13 ;PS(51.2 supp. by DBIA 2226
+14 ;PS(55 supp. by DBIA 2228
+15 ;PS(50.607 supp. by DBIA 2221
+16 ;DIC(5 supp. by DBIA 10056
+17 ;DPT supp. by DBIA 3097
+18 ;SC supp. by DBIA 10040
+19 ;VA(200 supp. by DBIA 10060
START ;
+1 DO PID(.PSI)
DO ORC(.PSI)
DO RXE(.PSI)
DO NTE(.PSI)
DO RXR(.PSI)
DO ZRL(.PSI)
+2 DO ZAL^PSOHLSG2(.PSI)
DO ZML^PSOHLSG2(.PSI)
DO ZSL^PSOHLSG2(.PSI)
+3 QUIT
PID(PSI) ;patient ID segment
+1 if '$DATA(DFN)!$DATA(PAS)
QUIT
+2 SET HLFS=HL1("FS")
SET HLECH=HL1("ECH")
SET HLQ=HL1("Q")
SET HLVER=HL1("VER")
+3 NEW X1,X2,D1,D2
+4 SET X1=$$EN^VAFHLPID(DFN,"3,5,8,11,13,19,",1)
+5 SET X2=$$EN^VAFHLZTA(DFN,"2,3,4,5,6,7,",1)
+6 ;if temp. address is active then use it
+7 IF $PIECE(X2,HLFS,3)
Begin DoDot:1
+8 if $PIECE(X2,HLFS,4)
SET D1=$$FMDATE^HLFNC($PIECE(X2,HLFS,4))
+9 if $PIECE(X2,HLFS,5)
SET D2=$$FMDATE^HLFNC($PIECE(X2,HLFS,5))
+10 IF $GET(D1)
IF $GET(D2)
IF (DT'<D1&(DT'>D2))
Begin DoDot:2
+11 if $PIECE(X2,HLFS,6)]""
SET $PIECE(X1,HLFS,12)=$PIECE(X2,HLFS,6)
SET $PIECE(X1,HLFS,14)=$PIECE(X2,HLFS,8)
End DoDot:2
End DoDot:1
+12 SET ^TMP("PSO",$JOB,PSI)=$EXTRACT(X1,1,245)
+13 SET PSI=PSI+1
SET PAS=1
+14 QUIT
ORC(PSI) ;common order segment
+1 if '$DATA(DFN)
QUIT
+2 NEW ORC
+3 if $GET(FP)="F"&('$GET(FPN))
SET FDT=$PIECE(^PSRX(IRXN,2),"^",2)
SET EXDT=$SELECT($PIECE(^(2),"^",6):$PIECE(^(2),"^",6),1:"")
+4 if $GET(FP)="F"&('$GET(FPN))
SET EBY=$PIECE(^PSRX(IRXN,0),"^",16)
SET PVDR=$PIECE(^(0),"^",4)
SET EFDT=$PIECE(^(2),"^",2)
+5 if $GET(FP)="F"&($GET(FPN))
SET FDT=$PIECE(^PSRX(IRXN,1,FPN,0),"^")
SET EXDT=$SELECT($PIECE(^(0),"^",15):$PIECE(^(0),"^",15),1:"")
+6 if $GET(FP)="F"&($GET(FPN))
SET EBY=$SELECT($PIECE(^PSRX(IRXN,1,FPN,0),"^",5):$PIECE(^(0),"^",5),1:$PIECE(^(0),"^",7))
SET PVDR=$PIECE(^(0),"^",17)
SET EFDT=$PIECE(^(0),"^",8)
+7 if $GET(FP)="P"
SET FDT=$PIECE(^PSRX(IRXN,"P",FPN,0),"^")
SET PVDR=$PIECE(^(0),"^",17)
SET EXDT=$SELECT($PIECE(^PSRX(IRXN,2),"^",6):$PIECE(^(2),"^",6),1:"")
+8 if $GET(FP)="P"
SET EBY=$SELECT($PIECE(^PSRX(IRXN,"P",FPN,0),"^",5):$PIECE(^(0),"^",5),1:$PIECE(^(0),"^",7))
SET PVDR=$PIECE(^(0),"^",17)
SET EFDT=$PIECE(^(0),"^",8)
+9 SET EBY1=$PIECE(^VA(200,EBY,0),"^")
SET PVDR1=$PIECE(^VA(200,PVDR,0),"^")
+10 SET FDT=$$HLDATE^HLFNC(FDT,"DT")
if $GET(EXDT)
SET EXDT=$$HLDATE^HLFNC(EXDT,"DT")
SET EFDT=$$HLDATE^HLFNC(EFDT,"DT")
+11 SET EBY1=$$HLNAME^HLFNC(EBY1)
SET PVDR1=$$HLNAME^HLFNC(PVDR1)
+12 SET ORC="ORC"_FS_"NW"_FS_IRXN_CS_"OP7.0"_FS_FS_FS_FS_FS_CS_CS_CS
+13 SET ORC=ORC_FDT_CS_EXDT_FS_FS_FS_EBY_CS_EBY1_FS_FS
+14 SET ORC=ORC_PVDR_CS_PVDR1_FS_FS_FS_EFDT_FS_CS_CS_CS_CS_"NEW"_FS_FS_FS_FS_FS_$SELECT($$STATUS^PSOBPSUT(IRXN,$GET(RXFL(IRXN)))]"":"VA5",1:"")
+15 SET ^TMP("PSO",$JOB,PSI)=ORC
+16 SET PSI=PSI+1
+17 KILL EBY,EBY1,EFDT,EXDT,FDT,PVDR,PVDR1
+18 QUIT
RXE(PSI) ;pharmacy encoded order segment
+1 if '$DATA(DFN)
QUIT
+2 NEW RXE
+3 SET PSND1=$PIECE($GET(^PSDRUG(IDGN,"ND")),"^")
SET PSND2=$PIECE($GET(^("ND")),"^",2)
SET PSND3=$PIECE($GET(^("ND")),"^",3)
+4 KILL PSOXN,PSOXN2
+5 IF PSND1
IF PSND3
Begin DoDot:1
+6 IF $TEXT(^PSNAPIS)]""
SET PSOXN=$$DFSU^PSNAPIS(PSND1,PSND3)
SET UNIT=$PIECE($GET(PSOXN),"^",6)
SET PSOXN=$PIECE($GET(PSOXN),"^",5)
SET PSOXN2=$$PROD2^PSNAPIS(PSND1,PSND3)
QUIT
+7 SET PSOXN2=$GET(^PSNDF(PSND1,5,PSND3,2))
+8 SET PRODUCT=$GET(^PSNDF(PSND1,5,PSND3,0))
+9 IF $GET(PRODUCT)'=""
SET PSOXN=+$PIECE($GET(^PSNDF(PSND1,2,+$PIECE(PRODUCT,"^",2),3,+$PIECE(PRODUCT,"^",3),4,+$PIECE(PRODUCT,"^",4),0)),"^")
SET UNIT=$PIECE($GET(^PS(50.607,PSOXN,0)),"^")
End DoDot:1
+10 SET RXE="RXE"_FS_""""""_FS_$SELECT($PIECE($GET(^PSDRUG(IDGN,"ND")),"^",10)'="":$PIECE(^("ND"),"^",10),($GET(PSND1)&$GET(PSND3)):$PIECE($GET(PSOXN2),"^",2),1:"""""")_CS_PSND2_CS_"PSNDF"
+11 SET RXE=RXE_CS_PSND1_"."_PSND3_"."_$GET(IDGN)_CS_$PIECE($GET(^PSDRUG(IDGN,0)),"^")_CS_"99PSD"_FS_""""""_FS_FS
+12 IF $GET(PSOXN)=""
SET PSOXN=""""""
+13 SET RXE=RXE_CS_CS_CS_PSOXN_CS_$SELECT($GET(UNIT)'="":$GET(UNIT),1:"""""")_CS_"99PSU"_FS
+14 KILL PSOXN,PSOXN2
+15 SET POIPTR=$PIECE($GET(^PSRX(IRXN,"OR1")),"^")
IF POIPTR
SET PODOSE=$PIECE($GET(^PS(50.7,POIPTR,0)),"^",2)
SET PODOSENM=$GET(^PS(50.606,PODOSE,0))
+16 IF '$GET(POIPTR)
SET PODOSE=$PIECE($GET(^PS(50.7,$PIECE($GET(^PSDRUG(IDGN,2)),"^"),0)),"^",2)
SET PODOSENM=$GET(^PS(50.606,PODOSE,0))
+17 ;S RXE=RXE_CS_CS_CS_$S($G(PODOSE):PODOSE,1:"""""")_CS_$S($G(PODOSENM):PODOSENM,1:"""""")_CS_"99PSF"_FS_FS_FS_FS_FS_CS_$P(^PSDRUG(IDGN,660),"^",8)_FS
+18 SET RXE=RXE_CS_CS_CS_PODOSE_CS_PODOSENM_CS_"99PSF"_FS_FS_FS_FS_FS_CS_$PIECE($GET(^PSDRUG(IDGN,660)),"^",8)_FS
+19 if $GET(FP)="F"&('$GET(FPN))
SET VPHARMID=$PIECE(^PSRX(IRXN,2),"^",3)
+20 if $GET(FP)="F"&($GET(FPN))
SET VPHARMID=$SELECT($PIECE(^PSRX(IRXN,1,FPN,0),"^",5)'="":$PIECE(^(0),"^",5),1:$PIECE(^PSRX(IRXN,2),"^",3))
+21 if $GET(FP)="P"
SET VPHARMID=$SELECT($PIECE(^PSRX(IRXN,"P",FPN,0),"^",5)'="":$PIECE(^(0),"^",5),1:$PIECE(^PSRX(IRXN,2),"^",3))
+22 IF '$GET(VPHARMID)
SET VPHARMID=""""""
SET VPHARM=""""""
+23 IF $GET(VPHARMID)
SET VPHARM=$PIECE(^VA(200,VPHARMID,0),"^")
SET VPHARM=$$HLNAME^HLFNC(VPHARM)
+24 SET NFLD=0
SET UU=""
FOR
SET UU=$ORDER(^PSRX(IRXN,1,UU))
if UU=""
QUIT
if $DATA(^PSRX(IRXN,1,UU,0))
SET NFLD=NFLD+1
+25 SET NRFL=$PIECE(^PSRX(IRXN,0),"^",9)
SET RFRM=(NRFL-NFLD)
SET DISPDT=$PIECE(^PSRX(IRXN,3),"^")
SET DISPDT=$$HLDATE^HLFNC(DISPDT,"DT")
+26 SET RXE=RXE_NRFL_FS_FS_VPHARMID_CS_VPHARM_FS_$PIECE(^PSRX(IRXN,0),"^")_FS_RFRM_FS_FS_DISPDT
+27 SET ^TMP("PSO",$JOB,PSI)=RXE
+28 SET PSI=PSI+1
+29 KILL PSND1,PSND2,PSND3,PRODUCT,UNIT,PODOSE,PODOSENM,POIPTR,VPHARMID,VPHARM,NRFL,DISPDT,UU
+30 QUIT
NTE(PSI) ;note segments
+1 ;
+2 DO NTE1^PSOHLSG2(.PSI)
+3 DO NTE2^PSOHLSG2(.PSI)
+4 DO NTE3^PSOHLSG2(.PSI)
+5 DO NTE4^PSOHLSG2(.PSI)
+6 DO NTE5^PSOHLSG2(.PSI)
+7 DO NTE6^PSOHLSG2(.PSI)
+8 QUIT
RXR(PSI) ;pharmacy route segment
+1 if '$DATA(DFN)
QUIT
+2 NEW RXR
+3 SET (PSROUTE,RTNAME)=""""""
+4 FOR PSRTLP=0:0
SET PSRTLP=$ORDER(^PSRX(IRXN,"MEDR",PSRTLP))
if 'PSRTLP
QUIT
Begin DoDot:1
+5 SET PSROUTE=$PIECE($GET(^PSRX(IRXN,"MEDR",PSRTLP,0)),"^")
IF PSROUTE
IF $DATA(^PS(51.2,PSROUTE,0))
SET RTNAME=$PIECE(^PS(51.2,PSROUTE,0),"^")
End DoDot:1
+6 SET RXR="RXR"_FS_CS_CS_CS_$GET(PSROUTE)_CS_$GET(RTNAME)_CS_"99PSR"
+7 SET ^TMP("PSO",$JOB,PSI)=RXR
+8 SET PSI=PSI+1
+9 KILL PSROUTE,RTNAME,PSRTLP
+10 QUIT
+11 ;
ZRL(PSI) ;Rx label segment
+1 if '$DATA(DFN)!('$DATA(PSOSITE))
QUIT
+2 NEW ZRL,ZRL1
+3 SET SITE=$SELECT($DATA(^PS(59,PSOSITE,0)):^(0),1:"")
+4 SET ZRL="ZRL"_FS_$PIECE(SITE,"^",6)_FS_$PIECE(SITE,"^",2)_CS_$PIECE(SITE,"^",7)_CS
+5 SET ZRL=ZRL_$SELECT($DATA(^DIC(5,+$PIECE(SITE,"^",8),0)):$PIECE(^(0),"^",2),1:"UKN")_CS
+6 SET PSZIP=$PIECE(SITE,"^",5)
SET PSOHZIP=$SELECT(PSZIP["-":PSZIP,1:$EXTRACT(PSZIP,1,5)_$SELECT($EXTRACT(PSZIP,6,9)]"":"-"_$EXTRACT(PSZIP,6,9),1:""))
+7 SET ZRL=ZRL_PSOHZIP_FS_$PIECE(SITE,"^",3)_"-"_$PIECE(SITE,"^",4)_FS
+8 SET CLN=+$PIECE(^PSRX(IRXN,0),"^",5)
SET CLN1=$SELECT($DATA(^SC(CLN,0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
+9 SET CSINER=$SELECT($PIECE(^PSRX(IRXN,3),"^",3):$PIECE(^(3),"^",3),1:"""""")
+10 SET CSINER1=$SELECT($GET(CSINER):$PIECE(^VA(200,CSINER,0),"^"),1:"""""")
SET CSINER1=$$HLNAME^HLFNC(CSINER1)
+11 SET ZRL=ZRL_CLN_CS_CLN1_CS_"99PSC"_FS_CSINER_CS_CSINER1_FS
+12 DO 6^VADPT
SET ZRL=ZRL_$EXTRACT($PIECE(VADM(2),"^",2),5,11)_FS_$PIECE(VADM(2),"^")_FS_$PIECE($GET(^PS(53,+$PIECE($GET(^PSRX(IRXN,0)),"^",3),0)),"^",2)_FS_$SELECT($PIECE($GET(VAPA(10)),"^",2)]"":$PIECE($GET(VAPA(10)),"^",2),1:"""""")_FS
+13 if $GET(FP)="F"&('$GET(FPN))
SET MW=$PIECE(^PSRX(IRXN,0),"^",11)
SET FDT=$PIECE(^(2),"^",2)
SET QTY=$PIECE(^(0),"^",7)
SET DASPLY=$PIECE(^(0),"^",8)
+14 if $GET(FP)="F"&($GET(FPN))
SET MW=$PIECE(^PSRX(IRXN,1,FPN,0),"^",2)
SET FDT=$PIECE(^(0),"^")
SET QTY=$PIECE(^(0),"^",4)
SET DASPLY=$PIECE(^(0),"^",10)
+15 if $GET(FP)="P"
SET MW=$PIECE(^PSRX(IRXN,"P",FPN,0),"^",2)
SET FDT=$PIECE(^(0),"^")
SET QTY=$PIECE(^(0),"^",4)
SET DASPLY=$PIECE(^(0),"^",10)
+16 IF MW="W"
SET MP=$SELECT($GET(^PSRX(IRXN,"MP")):$GET(^("MP")),1:"""""")
+17 SET X=$SELECT($DATA(^PS(55,DFN,0)):^(0),1:"")
SET CAP=$PIECE(X,"^",2)
+18 if MW="M"
SET MP=""""""
SET MW=$SELECT($PIECE(X,"^",3):"R",1:MW)
SET MW=$SELECT(MW="M":"REGULAR MAIL",MW="R":"CERTIFIED MAIL",1:"""""")
+19 IF (($PIECE(^PSRX(IRXN,"STA"),"^")>0)&($PIECE(^("STA"),"^")'=2)&('$GET(PSODBQ)))!'$GET(^PSRX(IRXN,"IB"))
SET COPAY="NO COPAY"
+20 IF '$TEST
SET COPAY="COPAY"
+21 SET ZRL=ZRL_MP_FS_COPAY_FS_$SELECT($GET(CAP):"NON-SAFETY",1:"SAFETY")_FS_$SELECT($GET(RFRM):"REFILLABLE",'$GET(RFRM):"NON-REFILLABLE",1:"""""")_FS
+22 SET ZRL=ZRL_$SELECT($GET(RFRM)>1:RFRM_" Refills remain prior to",$GET(RFRM)=1:"Last fill prior to",1:"""""")_FS_$SELECT($EXTRACT(MW)="W":"""""",1:MW)_FS
+23 SET NURSE=$SELECT($PIECE($GET(^DPT(DFN,"NHC")),"^")="Y":1,$PIECE($GET(^PS(55,DFN,40)),"^"):1,1:0)
+24 SET ZRL=ZRL_$SELECT($GET(NURSE):"Mfg______Exp______",1:"""""")_FS_$SELECT($GET(FP)="P":"PARTIAL",1:"""""")_FS
+25 SET DATE=$$HLDATE^HLFNC(FDT)
DO NOW^%DTC
SET NOW=$$HLDATE^HLFNC(%,"TS")
+26 KILL DIC,DR,DIQ
SET DA=$PIECE($$SITE^VASITE(),"^")
IF DA
Begin DoDot:1
+27 KILL PSOINST
SET DIC=4
SET DIQ(0)="I"
SET DR=99
SET DIQ="PSOINST"
DO EN^DIQ1
+28 SET PSOINST=PSOINST(4,DA,99,"I")
KILL DIC,DA,DR,DIQ,PSOINST(4)
End DoDot:1
+29 SET DRUG=$$ZZ^PSOSUTL(IRXN)
SET DEA=$PIECE($GET(^PSDRUG(+$PIECE(^PSRX(IRXN,0),"^",6),0)),"^",3)
SET WARN=$PIECE($GET(^(0)),"^",8)
+30 SET ZRL=ZRL_NOW_FS_DATE_FS_$SELECT($GET(NFLD):NFLD,1:"""""")_FS_DASPLY_FS_PSOINST_"-"_IRXN_FS_$SELECT($GET(WARN)'="":"DRUG WARNING "_$GET(WARN),1:"""""")_FS_QTY
+31 ;COMPENSATE FOR $L(ZRL)>245
+32 IF $LENGTH(ZRL)>245
SET LTH=$EXTRACT($LENGTH(ZRL)/245,1)
if $LENGTH(ZRL)#245>0
SET LTH=LTH+1
FOR WW=1:1:LTH
Begin DoDot:1
+33 if WW=1
SET ST=1
SET EN=245
if WW>1
SET ST=(ST+245)
SET EN=(EN+245)
+34 SET ZRL1=$EXTRACT(ZRL,ST,EN)
+35 if WW=1
SET ^TMP("PSO",$JOB,PSI)=ZRL1
+36 if WW>1
SET ^TMP("PSO",$JOB,PSI,WW-1)=ZRL1
End DoDot:1
+37 if '$DATA(LTH)
SET ^TMP("PSO",$JOB,PSI)=ZRL
+38 SET PSI=PSI+1
+39 KILL SITE,PSZIP,PSOHZIP,CLN,CLN1,CSINER,CSINER1,MW,MP,NOW,QTY,CAP,DASPLY,COPAY,NURSE,DATE,DRUG,WARN,DEA,LTH,WW,ST,EN,VADM,VAPA,%,X,NFLD,RFRM
+40 QUIT
