Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOHLDS5

PSOHLDS5.m

Go to the documentation of this file.
PSOHLDS5 ;BIR/MV - Misc HL7 function ; 23 Jan 2024  2:00 PM
 ;;7.0;OUTPATIENT PHARMACY;**643,728,742**;DEC 1997;Build 1
 ;External reference to ^PS(50.606 supported by DBIA 2174
 ;External reference to ^PS(50.7 supported by DBIA 2223
 ;External reference to ^PS(51.2 supported by DBIA 2226
 ;External reference to ^PS(54 supported by DBIA 2227
 ;External reference to ^PS(55 supported by DBIA 2228
 ;External reference to ^PS(59.7 is supported by DBIA 694
 ;External reference to ^PSDRUG supported by DBIA 221
 ;External reference to $$GETNDC^PSSNDCUT supported by DBIA 4707
 ;External reference to WTEXT^PSSWRNA supported by DBIA 4444
 ;External reference to DRUG^PSSWRNA supported by DBIA 4449
 ;External reference to EN^PSNPPIO supported by DBIA 3794
 ;External reference to BLDPID^VAFCQRY supported by DBIA 3630
 ;External reference to EN^VAFHLZTA supported by DBIA 758
 ;External reference to $$PROD2^PSNAPIS supported by DBIA 2531
HLSAVE(PSOLBL) ;Save HL data into PSOHLSV array
 NEW X,X1,X2,X3
 Q:'$D(PSOLBL)
 F X=0:0 S X=$O(PSOLBL(X)) Q:'X  Q:$D(PSOHLSV("COPAY STATUS"))  D
 .S PSOTXT=$G(PSOLBL(X)) Q:PSOTXT=""
 .K X1,X2,X3
 .I (PSOTXT["Rx# "),(PSOTXT[" Fill ") S X1=$P(PSOTXT," Fill ",2),X2=$P(X1,"    ") D  Q
 ..S X3=$P(X2," of")-1 S PSOHLSV("FILL NUMBER")=$S(X3<0:0,1:X3)
 .I PSOTXT["Days Supply:" S PSOHLSV("COPAY STATUS")=$S(PSOTXT["NO COPAY":"NO COPAY",PSOTXT["COPAY":"COPAY",1:"") I PSOTXT["NO COPAY" K PSOHLSV("COPAY NARR")
 Q
 ;
HLSVNTE(PSONARR) ;Save HL data into Patient Narrative array
 NEW X,PSOTXT,PSORF,PSONONRF,PSOCOPAY,PSOCNT
 Q:'$D(PSONARR)
 S (PSOCNT,PSORF,PSONONRF,PSOCOPAY)=0
 F X=0:0 S X=$O(PSONARR(X)) Q:'X  D
 .S PSOTXT=$P($G(PSONARR(X)),U,4) Q:PSOTXT="HOST:END"
 .I PSOTXT="HOST:NARRATIVE REFILLABLE RX" S PSOCNT=0,PSORF=1 Q
 .I PSOTXT="HOST:NARRATIVE NON-REFILLABLE RX" S (PSOCNT,PSORF)=0,PSONONRF=1 Q
 .I PSOTXT="HOST:NARRATIVE FOR COPAY DOCUMENT" S (PSOCNT,PSORF,PSONONRF)=0,PSOCOPAY=1 Q
 .I PSORF S PSOCNT=PSOCNT+1,PSOHLSV("NARR REFILLABLE",PSOCNT)=PSOTXT
 .I PSONONRF S PSOCNT=PSOCNT+1,PSOHLSV("NARR NON-REFILLABLE",PSOCNT)=PSOTXT
 .I $G(PSOHLSV("COPAY STATUS")),PSOCOPAY S PSOCNT=PSOCNT+1,PSOHLSV("NARR COPAY",PSOCNT)=PSOTXT
 Q
 ;
NTE2SV(CNT,NTECNT,PSOSITE) ; Patient Narrative
 NEW X,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,FS,LLL,ZZ
 Q:$G(PSOSITE)=""
 S FS="^"
 S CNT=+$G(CNT)+1,NTECNT=+$G(NTECNT)+1,^TMP("HLA",$J,CNT)="NTE"_FS_NTECNT_FS_FS_"Patient Narrative"
 K ^UTILITY($J,"W") S DIWL=1,DIWR=78,DIWF="" F ZZ=0:0 S ZZ=$O(^PS(59,PSOSITE,6,ZZ)) Q:'ZZ  I $D(^(ZZ,0)) S X=^(0) D ^DIWP
 S CNT=CNT+1,NTECNT=NTECNT+1,^TMP("HLA",$J,CNT)="NTE"_FS_NTECNT_FS_FS_"HOST:NARRATIVE REFILLABLE RX"
 F LLL=0:0 S LLL=$O(^UTILITY($J,"W",DIWL,LLL)) Q:'LLL  S CNT=CNT+1,NTECNT=NTECNT+1,^TMP("HLA",$J,CNT)="NTE"_FS_NTECNT_FS_FS_^UTILITY($J,"W",DIWL,LLL,0)
 ;
 S CNT=CNT+1,NTECNT=NTECNT+1,^TMP("HLA",$J,CNT)="NTE"_FS_NTECNT_FS_FS_"HOST:NARRATIVE NON-REFILLABLE RX"
 S DIWL=1,DIWR=45,DIWF="" K ^UTILITY($J,"W") F ZZ=0:0 S ZZ=$O(^PS(59,PSOSITE,7,ZZ)) Q:'ZZ  I $D(^(ZZ,0)) S X=^(0) D ^DIWP
 F LLL=0:0 S LLL=$O(^UTILITY($J,"W",DIWL,LLL)) Q:'LLL  S CNT=CNT+1,NTECNT=NTECNT+1,^TMP("HLA",$J,CNT)="NTE"_FS_NTECNT_FS_FS_^UTILITY($J,"W",DIWL,LLL,0)
 ;
 S CNT=CNT+1,NTECNT=NTECNT+1,^TMP("HLA",$J,CNT)="NTE"_FS_NTECNT_FS_FS_"HOST:NARRATIVE FOR COPAY DOCUMENT"
 S DIWL=1,DIWR=45,DIWF="" K ^UTILITY($J,"W") F ZZ=0:0 S ZZ=$O(^PS(59,PSOSITE,4,ZZ)) Q:'ZZ  I $D(^(ZZ,0)) S X=^(0) D ^DIWP
 F LLL=0:0 S LLL=$O(^UTILITY($J,"W",DIWL,LLL)) Q:'LLL  S CNT=CNT+1,NTECNT=NTECNT+1,^TMP("HLA",$J,CNT)="NTE"_FS_NTECNT_FS_FS_^UTILITY($J,"W",DIWL,LLL,0)
 ;
 S CNT=CNT+1,NTECNT=NTECNT+1,^TMP("HLA",$J,CNT)="NTE"_FS_NTECNT_FS_FS_"HOST:END"
 Q
 ;
PID(PSI) ;patient ID segment
 Q:'$D(DFN)!$D(PAS)
 N X,Y,X2,CNT,I
 S HLFS=HL1("FS"),HLECH=HL1("ECH"),HLQ=HL1("Q"),HLVER=HL1("VER")
 K PSPID,PSPID1
 D BLDPID^VAFCQRY(DFN,"","3,4,5,7,8,11,13",.PSPID,.HL1,.ERR)
 ; put PID in format needed for segment parser
 S PSPID=PSPID(1) K PSPID(1)
 S (X,Y)=1 F  S X=+$O(PSPID(X)) Q:'X  S PSPID(Y)=PSPID(X),Y=Y+1 K PSPID(X)
 ;parse PID into individual fields
 K PRSEPID D SEGPRSE^SCMSVUT5("PSPID","PRSEPID",HL1("FS"))
 ; parse address into individual components
 K ADDSEQ D SEQPRSE^SCMSVUT5($NA(PRSEPID(11)),"ADDSEQ",HL1("ECH"))
 ; build ZTA (Temporary Address)
 K X2 S X2=$$EN^VAFHLZTA(DFN,"1,2,3,4,5,6,7,",1)
 ; parse X2 (ZTA) into individual fields if temp add. exists
 D:'$$CHKTEMP(DFN)
 . N BADA S BADA=$$CHKRX(DFN)
 . I $P(BADA,"^"),'$P(BADA,"^",2),ADDSEQ(1,7)'["VAB" S BADA=$$GET1^DIQ(2,DFN_",",.121,"I") S:BADA ADDSEQ(1,7)="VAB"_BADA
 D:$$CHKTEMP(DFN)
 . K PRSEZTA D SEGPRSE^SCMSVUT5("X2","PRSEZTA",HL1("FS"))
 . ; parse temporary address into individual components
 . K TMPADD D SEQPRSE^SCMSVUT5($NA(PRSEZTA(5)),"TMPADD",HL1("ECH"))
 . ; add temporary address as next repetition in PID segment
 . S SPOT=1+$O(ADDSEQ(""),-1)
 . M ADDSEQ(SPOT)=TMPADD(1)
 . S ADDSEQ(SPOT,7)="C"
 . S ADDSEQ(SPOT,9)=PRSEZTA(6)
 . S ADDSEQ(SPOT,12,1)=PRSEZTA(3)
 . S ADDSEQ(SPOT,12,2)=PRSEZTA(4)
 . ;move address sequence back into parse PID segment
 ; rebuild PID segment
 K PRSEPID(11) M PRSEPID(11)=ADDSEQ
 K PSPID1 D MAKEIT^VAFHLU("PID",.PRSEPID,.PSPID1,.PSPID1)
 ;put rebuilt PID into format used by $$EN^VAFCQRY
 K PSPID S PSPID(1)=PSPID1
 S X=0,Y=2 F  S X=+$O(PSPID1(X)) Q:'X  S PSPID(Y)=PSPID1(X) S Y=Y+1
 S CNT=0 F I=1:1 Q:'$D(PSPID(I))  D
 . I I=1 S ^TMP("PSO",$J,PSI)=PSPID(I) Q
 . S CNT=CNT+1 S ^TMP("PSO",$J,PSI,CNT)=PSPID(I)
 S PSI=PSI+1
 S PAS=1
 K PSPID,PSPID1,PRSEPID,PRSEZTA,SPOT,TMPADD,ADDSEQ
 Q
 ;
CHKRX(PSODFN) ;CHECK ADDRESS BY DFN
 ;Input: PSORX - PRESCRIPTION file (#52) IEN
 ;Output: PSOBADR - Bad Address Indicator_"^"_temporary address or not
 N PSOBADR,PSOTEMP
 S PSOBADR=""
 S PSOBADR=$$BADADR^DGUTL3(PSODFN)
 I PSOBADR S PSOTEMP=$$CHKTEMP(PSODFN)
 S PSOBADR=PSOBADR_"^"_$G(PSOTEMP)
 Q PSOBADR
 ;
CHKTEMP(PSODFN) ; see if active temporary address
 ;Input: PSODFN - PATIENT file (#2) IEN
 N DFN,VAPA
 S DFN=PSODFN,PSOTEMP=0
 D 6^VADPT I +VAPA(9) S PSOTEMP=1
 Q PSOTEMP
 ;
PV1(PSI) ;patient visit segment
 Q:'$D(DFN)
 N PV1  ;hardcoded to letter O for Outpatient (Patient class)
 S PV1="PV1"_FS_FS_"O"_FS
 S ^TMP("PSO",$J,PSI)=PV1
 S PSI=PSI+1
 Q
 ;
PV2(PSI) ;patient visit segment (additional information)
 ;PATIENT STATUS AND COPAY
 Q:'$D(DFN)
 N PV2 S PV2=""
 S $P(PV2,"|",24)="UNKNOWN"_"~"_$G(PSOHLSV("COPAY STATUS"))_FS
 S ^TMP("PSO",$J,PSI)="PV2|"_PV2
 S PSI=PSI+1
 Q
 ;
ORC(PSI) ;common order segment
 N PSOROP3,PSOROP4,PSOHSITE,PSZIP,PSOHZIP
 Q:'$D(DFN)
 N ORC S ORC=""
 S $P(ORC,"|",1)="NW"
 S $P(ORC,"|",2)=$G(PSOHLSV("RX NUMBER"))_CS_"OP7.0"
 S PSOROP3=$G(PSOHLSV("OUT REQ PHARMACIST"))
 I PSOROP3'="" S PSOROP4=$$HLNAME^HLFNC(PSOROP3) S $P(ORC,"|",10)=CS_PSOROP4
 S PSOROP3=$G(PSOHLSV("PROVIDER"))
 I PSOROP3'="" S PSOROP4=$$HLNAME^HLFNC(PSOROP3) S $P(ORC,"|",12)=CS_PSOROP4
 I $G(PSOONLAP)'="" S $P(ORC,"|",13)=PSOONLAP
 S $P(ORC,"|",16)=$S($G(PSOHLSV("REQUEST TYPE"))="PR"!($G(PSOHLSV("REQUEST TYPE"))="OP"):"PARTIAL",1:"REFILL")
 S PSOHSITE=$S($G(PSOSITE):$G(^PS(59,PSOSITE,0)),1:"")
 S $P(ORC,"|",21)=$P(PSOHSITE,"^",1)_CS_CS_$P(PSOHSITE,"^",6)
 S PSZIP=$P(PSOHSITE,"^",5),PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
 S $P(ORC,"|",22)=$P(PSOHSITE,"^",2)_CS_CS_$P(PSOHSITE,"^",7)_CS_$S($D(^DIC(5,+$P(PSOHSITE,"^",8),0)):$P(^(0),"^",2),1:"UKN")_CS_PSOHZIP
 S $P(ORC,"|",23)="("_$P(PSOHSITE,"^",3)_")"_$P(PSOHSITE,"^",4)
 S ^TMP("PSO",$J,PSI)="ORC|"_ORC,PSI=PSI+1
 Q
 ;
NTE2(PSI) ; Site Narratives
 NEW X,CNT
 S:'$D(FS) FS="^" S:'+$G(PSI) PSI=1 S CNT=0
 I $S($G(PSOHLSV("NARR REFILLABLE",1))]"":1,$G(PSOHLSV("NARR NON-REFILLABLE",1))]"":1,$G(PSOHLSV("NARR COPAY",1))]"":1,1:0) D
 .S ^TMP("PSO",$J,PSI)="NTE"_FS_2_FS_FS_"Patient Narrative"
 F X=0:0 S X=$O(PSOHLSV("NARR REFILLABLE",X)) Q:'X  D
 .Q:$G(PSOHLSV("NARR REFILLABLE",X))=""
 .S CNT=CNT+1
 .S:CNT>1 ^TMP("PSO",$J,PSI,CNT-1)=^TMP("PSO",$J,PSI,CNT-1)_"\.sp\"
 .S ^TMP("PSO",$J,PSI,CNT)=PSOHLSV("NARR REFILLABLE",X)
 F X=0:0 S X=$O(PSOHLSV("NARR NON-REFILLABLE",X)) Q:'X  D
 .Q:$G(PSOHLSV("NARR NON-REFILLABLE",X))=""
 .S CNT=CNT+1
 .S:CNT>1 ^TMP("PSO",$J,PSI,CNT-1)=^TMP("PSO",$J,PSI,CNT-1)_"\.sp\"
 .S ^TMP("PSO",$J,PSI,CNT)=PSOHLSV("NARR NON-REFILLABLE",X)
 I $G(PSOHLSV("COPAY STATUS")) F X=0:0 S X=$O(PSOHLSV("NARR COPAY",X)) Q:'X  D
 .Q:$G(PSOHLSV("NARR COPAY",X))=""
 .S CNT=CNT+1
 .S:CNT>1 ^TMP("PSO",$J,PSI,CNT-1)=^TMP("PSO",$J,PSI,CNT-1)_"\.sp\"
 .S ^TMP("PSO",$J,PSI,CNT)=PSOHLSV("NARR COPAY",X)
 S:CNT PSI=PSI+1
 Q
 ;
NTE1(PSI) ;SIG
 N PSODR,PSODRR,PSOTSIG,PSOCLD M PSOTSIG=PSOHLSV("SIG")
 K PSODRR F PSODR=0:0 S PSODR=$O(PSOTSIG(PSODR)) Q:'PSODR  S PSODRR=$G(PSODRR)+1
 Q:'$G(PSODRR)
 S PSODRR=PSODRR+1,PSOTSIG(PSODRR)=FS_"Medication Instructions"
 K PSODRR S ^TMP("PSO",$J,PSI)="NTE"_FS_1_FS_FS
 S PSOCLD=1 F PSODR=0:0 S PSODR=$O(PSOTSIG(PSODR)) Q:'PSODR  D
 .S:$L($G(^TMP("PSO",$J,PSI,PSOCLD))_PSOTSIG(PSODR))>245 PSOCLD=PSOCLD+1 S ^TMP("PSO",$J,PSI,PSOCLD)=$G(^TMP("PSO",$J,PSI,PSOCLD))_PSOTSIG(PSODR)
 S PSI=PSI+1
 Q
 ;
NTE3(PSI) ;Drug Warning Narrative
 N NTE3,J,TEXT,W,CNT,PSSWSITE,PSOLCDRG,WARN,FLDX
 S PSOLCDRG=$G(PSOHLSV("L_DRUGIEN")) Q:'PSOLCDRG
 S WARN=$P($G(^PSDRUG(PSOLCDRG,0)),"^",8)
 S PSSWSITE=+$O(^PS(59.7,0))
 I $P($G(^PS(59.7,PSSWSITE,10)),"^",11)="N" D
 .S WARN=$$DRUG^PSSWRNA(PSOLCDRG,DFN)
 I WARN="" Q
 S NTE3="NTE"_FS_3_FS_FS,^TMP("PSO",$J,PSI)=NTE3,CNT=1
 F J=1:1 S W=$P(WARN,",",J) Q:W=""  D
 . S:CNT>1 ^TMP("PSO",$J,PSI,CNT-1)=^TMP("PSO",$J,PSI,CNT-1)_"\.sp\"
 . S TEXT=$$WTEXT^PSSWRNA(W,$G(PSOOLAN)) I TEXT'="" S FLDX=1 D
 . . I $L(TEXT)<245 S ^TMP("PSO",$J,PSI,CNT)=TEXT,CNT=CNT+1 Q
 . . N LTH,ST,EN,TXT,WW
 . . S LTH=$E($L(TEXT)/245,1) S:$L(TEXT)#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 TXT=$E(TEXT,ST,EN)
 . . . S ^TMP("PSO",$J,PSI,CNT)=TXT,CNT=CNT+1
 I $G(FLDX) D  S PSI=PSI+1
 . I $L(^TMP("PSO",$J,PSI,CNT-1)_FS_"Drug Warning Narrative")<245 S ^TMP("PSO",$J,PSI,CNT-1)=$G(^TMP("PSO",$J,PSI,CNT-1))_FS_"Drug Warning Narrative"
 . E  S ^TMP("PSO",$J,PSI,CNT)=FS_"Drug Warning Narrative"
 Q
 ;
NTE4(PSI) ;Profile information
 S PSODFN=DFN N NTE4
 I $P(PSOPAR,"^",8) D START^PSOHLDS3
 S:$D(NTE4) PSI=PSI+1
 Q
 ;
RXE(PSI) ;
 N PSOXN,PSOUNIT,PSOIPTR,PSODOSE,PSODOSEN,X,PSOVNAME,PSOXNDF1,PSORFRM,PRORFTOT,PSORFGIV,PSOSTALK,PSOCSUB,PSOCSUB1
 S PSOVNAME="" I PSOND1,PSOND3 D
 .S PSOVNAME=$P($$PROD2^PSNAPIS(PSOND1,PSOND3),"^")
 .S (PSOXN,PSOXNDF1)=$$DFSU^PSNAPIS(PSOND1,PSOND3),PSOUNIT=$P($G(PSOXN),"^",6)
 S PSOXN=$P($G(PSOXN),"^",5)
 S PSOSTALK=+$G(^PS(55,"ASTALK",DFN))
 S PSOCSUB1=$$GET1^DIQ(50,PSOLDRUG_",",3),PSOCSUB="N" I $E(PSOCSUB1,1)>1&($E(PSOCSUB1,1)<6) S PSOCSUB="Y"
 N RXE S RXE="" S $P(RXE,"|",1)=""""""
 S $P(RXE,"|",2)=$S($P($G(^PSDRUG(PSOLDRUG,"ND")),"^",10)'="":$P(^("ND"),"^",10),($G(PSOND1)&$G(PSOND3)):$P($G(PSOXN2),"^",2),1:"""""")_CS_$G(PSOND2)_CS_"99PSNDF"_CS_PSOND1_"."_PSOND3_"."_$G(PSOLDRUG)_CS_PSOLLNM_CS_"99PSD"
 S $P(RXE,"|",3)="" I $G(PSOXN)="" S PSOXN=""""""
 S $P(RXE,"|",5)=PSOXN_CS_$S($G(PSOUNIT)'="":$G(PSOUNIT),1:"""""")_CS_"99PSU"
 S PSOIPTR=$P($G(^PSDRUG(PSOLDRUG,2)),"^") I PSOIPTR S PSODOSE=$P($G(^PS(50.7,PSOIPTR,0)),"^",2),PSODOSEN=$P($G(^PS(50.606,PSODOSE,0)),"^")
 I 'PSOIPTR,$G(PSOXNDF1)'="" S PSODOSE=$P(PSOXNDF1,"^"),PSODOSEN=$P(PSOXNDF1,"^",2)
 I $G(PSODOSE) S $P(RXE,"|",6)=PSODOSE_CS_PSODOSEN_CS_"99PSF"
 I '$G(PSODOSE) S $P(RXE,"|",6)=""""""
 S $P(RXE,"|",8)=""""""
 S $P(RXE,"|",9)=""""""
 S $P(RXE,"|",10)=$G(PSOHLSV("QUANTITY"))
 S PSORFTOT=$G(PSOHLSV("TOTAL FILLS"))-1
 S PSORFRM=$G(PSOHLSV("TOTAL FILLS"))-$G(PSOHLSV("FILL NUMBER"))
 S PSORFGIV=$G(PSOHLSV("FILL NUMBER"))-1
 S $P(RXE,"|",11)=CS_$P($G(^PSDRUG(PSOLDRUG,660)),"^",8),$P(RXE,"|",12)=PSORFTOT
 S $P(RXE,"|",13)=""""""
 S $P(RXE,"|",14)=""""""
 S $P(RXE,"|",15)=$G(PSOHLSV("RX NUMBER")),$P(RXE,"|",16)=PSORFRM,$P(RXE,"|",17)=PSORFGIV
 S $P(RXE,"|",18)=""""""
 S $P(RXE,"|",21)=CS_PSOLLNM_RS_CS_PSOVNAME   ;*255
 S $P(RXE,"|",31)=PSOCSUB_RS_PSOSTALK_RS_PSOOTLAN
 S ^TMP("PSO",$J,PSI)="RXE|"_RXE,PSI=PSI+1
 Q
 ;
RXD(PSI) ;pharmacy dispense segment
 N RXD,I,PSODEA,PSONDC,PSOHDT,PSORWARN,PSONDCL,PSONDCLS,PSONDCND
 S PSODEA=$P($G(^PSDRUG(PSOLDRUG,0)),"^",3)
 S PSORWARN=$P($G(^PSDRUG(PSOLDRUG,0)),"^",8)
 S PSONDC=$P($G(^PSDRUG(PSOLDRUG,2)),"^",4)
 I $G(PSOSITE) S PSONDCLS=0 D
 .F PSONDCL=0:0 S PSONDCL=$O(^PSDRUG(PSOLDRUG,"NDCOP",PSONDCL)) Q:'PSONDCL!(PSONDCLS)  D
 ..S PSONDCND=$G(^PSDRUG(PSOLDRUG,"NDCOP",PSONDCL,0))
 ..I $P(PSONDCND,"^")=PSOSITE S PSONDCLS=1 I $P(PSONDCND,"^",2)'="" S PSONDC=$P(PSONDCND,"^",2)
 I PSONDC?11N S PSONDC=$$NDCFMT^PSSNDCUT(PSONDC)
 I PSONDC'?5N1"-"4N1"-"2N S PSONDC=""
 S WNS="" I $G(PSORWARN) F I=1:1 S WW=$P(PSORWARN,",",I) Q:WW=""  S WNS=WNS_WW_CS_$S(WW'["N":^PS(54,WW,0),1:"")_RS
 S RXD="RXD"_FS_""""""_FS_$S($P($G(^PSDRUG(PSOLDRUG,"ND")),"^",10)'="":$P(^("ND"),"^",10),($G(PSOND1)&$G(PSOND3)):$P($G(PSOXN2),"^",2),1:"""""")_CS_PSOND2_CS_"99PSNDF"  ;*531
 S RXD=RXD_CS_PSOND1_"."_PSOND3_"."_PSOLDRUG_CS_PSOLLNM_CS_"99PSD"
 S PSOHDT=$$HLDATE^HLFNC(DT,"DT")
 S RXD=RXD_FS_PSOHDT_FS_FS_FS_FS_$G(PSOHLSV("RX NUMBER"))_FS_($G(PSOHLSV("TOTAL FILLS"))-1)
 S RXD=RXD_FS_PSODEA_RS_PSONDC_FS_""""""_FS
 S RXD=RXD_FS_$G(PSOHLSV("DAYS SUPPLY"))_FS_$G(PSOHLSV("ROUTING"))_FS_FS_CS_$G(PSOHLSV("CAP"))
 S RXD=RXD_FS_FS_FS_FS_""""""_FS_FS_FS_FS_FS_FS_WNS_FS_FS
 S ^TMP("PSO",$J,PSI)=RXD,PSI=PSI+1
 Q
 ;
NTEPMI(PSI) ;build NTE segment for PMI sheets                   ;*255
 Q:'$D(DFN)  N A,I,PREVLN,CURRLN,PMI,PSNMSG
 S PMI=$$EN^PSNPPIO(PSOLDRUG,.PSNMSG)
 Q:'$D(^TMP($J,"PSNPMI"))
 ;PSO*7*279 Add missing PMI ID(7) to NTE Segment
 S ^TMP("PSO",$J,PSI)="NTE"_FS_7_FS_FS_^TMP($J,"PSNPMI",0)
 K A S CNT1=1,CNT=0
 F A="W","U","H","S","M","P","I","O","N","D","R" S CNT=CNT+1,A(CNT)=A
 F I=1:1:11 I $D(^TMP($J,"PSNPMI",A(I))) D
 .S CNT=$P(^TMP($J,"PSNPMI",A(I),0),"^",3)
 .S (PREVLN,CURRLN)=""
 .F J=1:1:CNT D
 .. S ^TMP("PSO",$J,PSI,CNT1)=^TMP($J,"PSNPMI",A(I),J,0)
 .. ;PSO*198 check if " " should be inserted
 .. S CURRLN=^TMP("PSO",$J,PSI,CNT1)
 .. S:CNT1>1 PREVLN=$S(CNT>1:^TMP("PSO",$J,PSI,CNT1-1),1:"")
 .. I CNT1>1,$$SPACE^PSOHLDS3(PREVLN,CURRLN) D
 ... S ^TMP("PSO",$J,PSI,CNT1)=" "_^TMP("PSO",$J,PSI,CNT1)
 .. I J=1 S $P(^TMP("PSO",$J,PSI,CNT1),":",1)="\H\"_$P(^TMP("PSO",$J,PSI,CNT1),":",1)_"\N\"
 .. S CNT1=CNT1+1
 S ^TMP("PSO",$J,PSI,CNT1-1)=^TMP("PSO",$J,PSI,CNT1-1)_FS_"Patient Medication Instructions"
 S PSI=PSI+1 K A,I,J,CNT,CNT1,^TMP($J,"PSNPMI")
 Q
 ;
RXR(PSI) ;pharmacy route segment
 Q:'$D(DFN)
 N RXR
 S RXR="RXR"_FS
 S ^TMP("PSO",$J,PSI)=RXR,PSI=PSI+1
 Q
 ;
ZZZ(PSI) ;ZZZ segment for HL7 hazardous text ;*524
 N DRIEN,HAZD,HAZH,VAR
 S DRIEN=PSOLDRUG
 S VAR=$$HAZ^PSSUTIL(DRIEN)
 S HAZH=$P(VAR,"^",1)
 S HAZH=$S(HAZH:"Y",1:"N")
 S HAZD=$P(VAR,"^",2)
 S HAZD=$S(HAZD:"Y",1:"N")
 S ^TMP("PSO",$J,PSI)="ZZZ"_FS_FS_FS_FS_HAZH_FS_HAZD
 S PSI=PSI+1
 Q
 ;
SEND ;Send message to Host Site with Dispensing information from OPAI fill
 N %,PSOPROT,PSODOMVR,PSORRDAT,HLARR,PSOHSIEN,PSOHSTYP,PSOHSSUB,PSOHSZ,PSOHSRX,DFN,PSODONE,PSOFOUR,PSOSRXD2,PSOSRXD3,PSOSRXD4,PSOSRXD7,PSOHFLAG,PSOHONE,PSOSRDEN,PSODND1,PSODND2,PSODND3,PSODNNOW,PSOHCNT
 S HLARR=$NA(^TMP("HLS",$J)) K @HLARR
 S PSOPROT="PSO DISP RX RDS-O13 EVENT"
 S PSODOMVR=$P($G(^PSRXR(52.09,PSOPAID("IEN"),4)),"^",2)
 S DFN=$P($G(^PSRXR(52.09,PSOPAID("IEN"),0)),"^",2)
 D INIT^HLFNC2(PSOPROT,.HL)
 D BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
 S PSOHSZ=$G(^PSRXR(52.09,PSOPAID("IEN"),0)),PSOFOUR=$G(^PSRXR(52.09,PSOPAID("IEN"),4)),PSOHONE=$G(^PSRXR(52.09,PSOPAID("IEN"),1))
 S PSOHSIEN=$P(PSOHSZ,"^",15),PSOHSTYP=$S($P(PSOHSZ,"^",5)="PR":"PR",$P(PSOHSZ,"^",5)="OP":"PR",1:"RF"),PSOSRXD7=$P(PSOHSZ,"^",3),PSOSRXD4=$P(PSOHSZ,"^",7)
 S PSOHSSUB=$S(PSOHSTYP="PR":$P(PSOHSZ,"^",14),1:$P(PSOHSZ,"^",13)),PSOHSRX=$P(PSOHSZ,"^",3)
 S PSOHFLAG=0,PSOSRDEN=+$P(PSOHONE,"^",2),PSODND1=$P($G(^PSDRUG(PSOSRDEN,"ND")),"^"),PSODND2=$P($G(^("ND")),"^",2),PSODND3=$P($G(^("ND")),"^",3) I PSODND1,PSODND3 S PSOHFLAG=1
 S PSOSRXD2=$S(PSOHFLAG:PSODND1_"."_PSODND3_"~"_$G(PSODND2)_"~"_"99NDF",1:"~~")_"~"_PSOSRDEN_"~"_$P($G(^PSDRUG(PSOSRDEN,0)),"^")_"~"_"99PSD"
 D NOW^%DTC S PSODNNOW=$$HLDATE^HLFNC(%,"TS") S PSOSRXD3=PSODNNOW
 S PSODONE=0
 F PSOHCNT=1:1 D  Q:PSODONE
 .I '$D(PSORRDAT(PSOHCNT)) S PSODONE=1 Q
 .S @HLARR@(1)=$G(@HLARR@(1))_PSORRDAT(PSOHCNT)
 S @HLARR@(2)="ORC|"_PSOHSTYP_"|"_PSOHSRX_"~"_PSODOMVR_"||||||||"_$P(PSOHSZ,"^",11)_"|"_$P(PSOHSZ,"^",12)
 S @HLARR@(3)="RXD|"_PSOHSSUB_"|"_PSOSRXD2_"|"_PSOSRXD3_"|"_PSOSRXD4_"|||"_PSOSRXD7_"||"_PSOHNDC_"||||"_PSOHSIEN_"|||||"_PSOHLOT_"|"_PSODEXP_"|"_PSOHMAN
 S @HLARR@(4)="NTE|1|L|"_$P(PSOFOUR,"^")_"|"_$P(PSOFOUR,"^",3)_"|"_$P(PSOFOUR,"^",4)_"|"_$P(PSOFOUR,"^",5)
 S @HLARR@(5)="RXR|~~~0~UNKNOWN~99PSR"
 S HLP("SUBSCRIBER")="^^^^"_PSODOMVR
 D GENERATE^HLMA(PSOPROT,"GM",1,.HL,"",.HLP)
 K @HLARR
 Q