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