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