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

PSOHLDS2.m

Go to the documentation of this file.
  1. PSOHLDS2 ;BHAM ISC/PWC,SAB-Build HL7 Segments for automated interface ;11/22/06 3:24pm
  1. ;;7.0;OUTPATIENT PHARMACY;**156,198,255,200,268,305,336,434,282,531,524**;DEC 1997;Build 28
  1. ;DIWP supported by DBIA 10011
  1. ;^PS(50.606 supported by DBIA 2174
  1. ;^PS(50.7 supported by DBIA #2223
  1. ;^PS(51 supported by DBIA 2224
  1. ;^PS(51.2 supported by DBIA 2226
  1. ;^PS(55 supported by DBIA 2228
  1. ;^PSDRUG supported by DBIA 221
  1. ;^PS(54 supported by DBIA 2227
  1. ;Cont'd build HL7 segments
  1. ;
  1. ;*198 add check to insert spaces into PMI segments
  1. ;*255 add 2 new fields to RXE.21 (label name & VA PRINT NAME)
  1. ; and move NTEPMI tag to PSOHLDS4
  1. ;*305 send Notice of Privacy Practices in NTE9 - Modified to NTE9 as NTE8 already exist
  1. ;*524 add ZZZ segment for HAZ info to OPAI
  1. ;
  1. RXE(PSI) ;pharmacy encoded order segment
  1. Q:'$D(DFN) N RXE S RXE="" S $P(RXE,"|",1)=""""""
  1. S $P(RXE,"|",2)=$S($P($G(^PSDRUG(IDGN,"ND")),"^",10)'="":$P(^("ND"),"^",10),($G(PSND1)&$G(PSND3)):$P($G(PSOXN2),"^",2),1:"""""")_CS_$G(PSND2)_CS_"99PSNDF"_CS_PSND1_"."_PSND3_"."_$G(IDGN)_CS_$P($G(^PSDRUG(IDGN,0)),"^")_CS_"99PSD"
  1. S $P(RXE,"|",3)="" I $G(PSOXN)="" S PSOXN=""""""
  1. S $P(RXE,"|",5)=PSOXN_CS_$S($G(UNIT)'="":$G(UNIT),1:"""""")_CS_"99PSU"
  1. S POIPTR=$P($G(^PSRX(IRXN,"OR1")),"^") I POIPTR S PODOSE=$P($G(^PS(50.7,POIPTR,0)),"^",2),PODOSENM=$P($G(^PS(50.606,PODOSE,0)),"^")
  1. I '$G(POIPTR) S PODOSE=$P($G(^PS(50.7,$P($G(^PSDRUG(IDGN,2)),"^"),0)),"^",2),PODOSENM=$P($G(^PS(50.606,PODOSE,0)),"^")
  1. S TRADENM=$G(^PSRX(IRXN,"TN")),$P(RXE,"|",6)=PODOSE_CS_PODOSENM_CS_"99PSF"
  1. S $P(RXE,"|",8)=MP,$P(RXE,"|",9)=TRADENM,$P(RXE,"|",10)=QTY
  1. S $P(RXE,"|",11)=CS_$P($G(^PSDRUG(IDGN,660)),"^",8),$P(RXE,"|",12)=NRFL
  1. S $P(RXE,"|",13)=DEAID,$P(RXE,"|",14)=VPHARMID_CS_$P(VPHARM,",",1)_CS_$P(VPHARM,",",2)
  1. S $P(RXE,"|",15)=$P(^PSRX(IRXN,0),"^"),$P(RXE,"|",16)=RFRM,$P(RXE,"|",17)=NFLD
  1. S $P(RXE,"|",18)=PRIORDT,$P(RXE,"|",31)=CSUB_RS_SCTALK_RS_OTLAN
  1. S $P(RXE,"|",21)=CS_DRUG_RS_CS_$G(VANAME) ;*255
  1. S ^TMP("PSO",$J,PSI)="RXE|"_RXE,PSI=PSI+1
  1. K PODOSE,PODOSENM,POIPTR,TRADENM,UU
  1. Q
  1. RXD(PSI) ;pharmacy dispense segment
  1. Q:'$D(DFN) N RXD,I
  1. S WNS="" I $G(WARN) F I=1:1 S WW=$P(WARN,",",I) Q:WW="" S WNS=WNS_WW_CS_$S(WW'["N":^PS(54,WW,0),1:"")_RS
  1. S RXD="RXD"_FS_$S($G(FPN):FPN,1:0)_FS_$S($P($G(^PSDRUG(IDGN,"ND")),"^",10)'="":$P(^("ND"),"^",10),($G(PSND1)&$G(PSND3)):$P($G(PSOXN2),"^",2),1:"""""")_CS_PSND2_CS_"99PSNDF" ;*531
  1. S RXD=RXD_CS_PSND1_"."_PSND3_"."_$G(IDGN)_CS_$P($G(^PSDRUG(IDGN,0)),"^")_CS_"99PSD"
  1. S RXD=RXD_FS_DISPDT_FS_FS_FS_FS_$P(^PSRX(IRXN,0),"^")_FS_NRFL
  1. S RXD=RXD_FS_DEA_RS_PSONDC_FS_$S(FIN'="":FIN_CS_FIN1,1:"")_FS
  1. S RXD=RXD_FS_DASPLY_FS_MW_FS_FS_CS_$S($G(CAP):"NON-SAFETY",1:"SAFETY")
  1. S RXD=RXD_FS_FS_FS_FS_EXDT_FS_FS_FS_FS_FS_FS_WNS_FS_FS
  1. S ^TMP("PSO",$J,PSI)=RXD,PSI=PSI+1
  1. Q
  1. RXR(PSI) ;pharmacy route segment
  1. Q:'$D(DFN) N RXR S (PSROUTE,RTNAME)=""""""
  1. F PSRTLP=0:0 S PSRTLP=$O(^PSRX(IRXN,6,PSRTLP)) Q:'PSRTLP D
  1. .S PSROUTE=$P($G(^PSRX(IRXN,6,PSRTLP,0)),"^",7)
  1. .I PSROUTE,$D(^PS(51.2,PSROUTE,0)) S RTNAME=$P(^PS(51.2,PSROUTE,0),"^")
  1. I RTNAME="" K PSROUTE,RTNAME,PSRTLP Q
  1. S RXR="RXR"_FS_$G(PSROUTE)_CS_$G(RTNAME)_CS_"99PSR"_FS_FS_FS_FS
  1. S ^TMP("PSO",$J,PSI)=RXR,PSI=PSI+1
  1. K PSROUTE,RTNAME,PSRTLP
  1. Q
  1. SIG K OT S SGY="" F P=1:1:$L(SIG," ") S X=$P(SIG," ",P) D:X]""
  1. .I $D(^PS(51,"A",X)) D
  1. ..;PSO*7*282 Intended Use
  1. ..I $P($G(^PS(55,DFN,"LAN")),"^") S OT=$O(^PS(51,"B",X,0)) I OT,($P(^PS(51,OT,0),"^",4)<2)&($P($G(^PS(51,OT,4)),"^")]"") S X=$P(^PS(51,OT,4),"^") K OT Q
  1. ..;S %=^PS(51,"A",X),X=$P(%,"^") I $P(%,"^",2)]"" S Y=$P(SIG," ",P-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(%,"^",2)
  1. .S SGY=SGY_X_" "
  1. S X="",SGC=1 F J=1:1 S Z=$P(SGY," ",J) S:Z="" SGY(SGC)=X Q:Z="" S:$L(X)+$L(Z)'<$S($P(PSOPAR,"^",28):46,1:34) SGY(SGC)=X,SGC=SGC+1,X="" S X=X_Z_" "
  1. SIGOLD I '$P(PSOPAR,"^",28) D K NHC
  1. .K DIC,DR,DIQ,NHC S DIC=2,DA=DFN,DR=148,DIQ="NHC",DIQ(0)="I"
  1. .D EN^DIQ1 K DIC,DR,DIQ
  1. .I NHC(2,DFN,148,"I")="Y"!($P($G(^PS(55,DFN,40)),"^")) S SGC=SGC+1,SGY(SGC)="Expiration:________ Mfg:_________"
  1. Q
  1. ;
  1. PSOLBL3 ;RX must be defined (Internal), Check already done for OERR SIG
  1. ;Format OERR Sig for New and Old label stock
  1. N CTCT,FFFF,LLIM,LLLL,LVAR,LVAR1,PPP,PPPP,SGCT,SIG9,ZZZZ,PSLONG,PPPP
  1. S RX=IRXN
  1. I $P($G(^PS(55,DFN,"LAN")),"^") N II D OTHL^PSOLBL3 G:$G(FND) FMSIG
  1. S PSLONG=$S($P(PSOPAR,"^",28):46,1:34)
  1. ; NEXT LINE IF SIG IS MOVED BACK TO MULTIPLE
  1. S PPPP=1 F PPP=0:0 S PPP=$O(^PSRX(RX,"SIG1",PPP)) Q:'PPP I $G(^PSRX(RX,"SIG1",PPP,0))'="" S SIG9(PPPP)=^(0) S PPPP=PPPP+1
  1. ;NEXT LINE IF 1ST FRONT DOOR SIG LINE LIVES IN BACK DOOR SPOT
  1. FMSIG S (LVAR,LVAR1)="",LLLL=1
  1. F FFFF=0:0 S FFFF=$O(SIG9(FFFF)) Q:'FFFF S SGCT=0 F ZZZZ=1:1:$L(SIG9(FFFF)) I $E(SIG9(FFFF),ZZZZ)=" "!($L(SIG9(FFFF))=ZZZZ) S SGCT=SGCT+1 D I $L(LVAR)>PSLONG S SGY(LLLL)=LLIM_" ",LLLL=LLLL+1,LVAR=LVAR1
  1. .S LVAR1=$P(SIG9(FFFF)," ",(SGCT)),LLIM=LVAR,LVAR=$S(LVAR="":LVAR1,1:LVAR_" "_LVAR1)
  1. I $G(LVAR)'="" S SGY(LLLL)=LVAR
  1. I '$P(PSOPAR,"^",28) S SGC=0 F CTCT=0:0 S CTCT=$O(SGY(CTCT)) Q:'CTCT S SGC=SGC+1
  1. I $O(OSGY(0)) D
  1. .F I=0:0 S I=$O(SGY(I)) Q:'I I $G(OSGY(I))']"" S OSGY(I)=" "
  1. .F I=0:0 S I=$O(OSGY(I)) Q:'I I $G(SGY(I))']"" S SGY(I)=" "
  1. Q
  1. NTE ;build NTE segment for SIG
  1. ;
  1. Q:'$D(DFN)
  1. ; 1 = SIG
  1. ; 2 = PI Narrative
  1. ; 3 = Drug Warning
  1. ; 4 = Profile
  1. ; 5 = Drug Interaction
  1. ; 6 = Drug Allergy
  1. ; 7 = PMI Sheet (NTEPMI in PSOHLDS4)
  1. ; 8 = Medication Instructions
  1. ; 9 = Privacy Notification
  1. ;
  1. K FLDX
  1. D NTE1(.PSI) K FLDX D NTE2(.PSI) K FLDX D NTE3(.PSI) K FLDX
  1. D NTE4(.PSI) K FLDX D NTE5(.PSI) K FLDX D NTE6(.PSI) K FLDX
  1. Q
  1. ;
  1. NTE1(PSI) ;SIG
  1. S SIG=$P($G(^PSRX(IRXN,"SIG")),"^")
  1. I $P($G(^PSRX(IRXN,"SIG")),"^",2) D PSOLBL3,SIGOLD
  1. I '$P($G(^PSRX(IRXN,"SIG")),"^",2) D SIG
  1. I $O(OSGY(0)) D G KNTE
  1. .K DRR F DR=0:0 S DR=$O(SGY(DR)) Q:'DR S DRR=$G(DRR)+1
  1. .S DRR=DRR+1,SGY(DRR)=FS_"Medication Instructions (LANGUAGE PREFERENCE)"
  1. .K DRR F DR=0:0 S DR=$O(OSGY(DR)) Q:'DR S DRR=$G(DRR)+1
  1. .S DRR=DRR+1,OSGY(DRR)=FS_"Medication Instructions (ENGLISH)"
  1. .K DRR S ^TMP("PSO",$J,PSI)="NTE"_FS_1_FS_FS
  1. .S CLD=1 F DR=0:0 S DR=$O(OSGY(DR)) Q:'DR D
  1. ..S:$L($G(^TMP("PSO",$J,PSI,CLD))_OSGY(DR))>245 CLD=CLD+1 S ^TMP("PSO",$J,PSI,CLD)=$G(^TMP("PSO",$J,PSI,CLD))_OSGY(DR)
  1. .S PSI=PSI+1,^TMP("PSO",$J,PSI)="NTE"_FS_8_FS_FS
  1. .S CLD=1 F DR=0:0 S DR=$O(SGY(DR)) Q:'DR D
  1. ..S:$L($G(^TMP("PSO",$J,PSI,CLD))_SGY(DR))>245 CLD=CLD+1 S ^TMP("PSO",$J,PSI,CLD)=$G(^TMP("PSO",$J,PSI,CLD))_SGY(DR)
  1. K DRR F DR=0:0 S DR=$O(SGY(DR)) Q:'DR S DRR=$G(DRR)+1
  1. S DRR=DRR+1,SGY(DRR)=FS_"Medication Instructions"
  1. K DRR S ^TMP("PSO",$J,PSI)="NTE"_FS_1_FS_FS
  1. S CLD=1 F DR=0:0 S DR=$O(SGY(DR)) Q:'DR D
  1. .S:$L($G(^TMP("PSO",$J,PSI,CLD))_SGY(DR))>245 CLD=CLD+1 S ^TMP("PSO",$J,PSI,CLD)=$G(^TMP("PSO",$J,PSI,CLD))_SGY(DR)
  1. KNTE S PSI=PSI+1 K DR,CLD,DRR,SIG,E,F,S,FLD1,X,Y,SGY,SGC,Z,DR,%,J,P,NT1,ST,EN,LTH
  1. Q
  1. LENGTH(NT1) ; compensate for length > 245
  1. I $L(NT1)>245 S LTH=$E($L(NT1)/245,1) S:$L(NT1)#245>0 LTH=LTH+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 NT11=$E(NT1,ST,EN)
  1. . S:WW=1 ^TMP("PSO",$J,PSI)=NT11 S:WW>1 ^TMP("PSO",$J,PSI,WW-1)=NT11
  1. S:'$D(LTH) ^TMP("PSO",$J,PSI)=NT1 S PSI=PSI+1
  1. Q
  1. NTE2(PSI) ; Patient Narrative
  1. K ^UTILITY($J,"W") S (DIWL,PSNACNT)=1,DIWR=45,DIWF="",(PSSIXFL,PSSEVFL)=0 F ZZ=0:0 S ZZ=$O(^PS(59,PSOSITE,6,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 ^TMP("PSO",$J,PSI,PSNACNT)=^UTILITY($J,"W",DIWL,LLL,0) S PSNACNT=PSNACNT+1,PSSIXFL=1
  1. I PSSIXFL S ^TMP("PSO",$J,PSI)="NTE"_FS_2_FS_FS,^TMP("PSO",$J,PSI,PSNACNT)=" " S PSNACNT=PSNACNT+1,FLDX=1
  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 ^TMP("PSO",$J,PSI,PSNACNT)=^UTILITY($J,"W",DIWL,LLL,0) S PSNACNT=PSNACNT+1,PSSEVFL=1
  1. I PSSEVFL S ^TMP("PSO",$J,PSI,PSNACNT)=" " S PSNACNT=PSNACNT+1
  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 ^TMP("PSO",$J,PSI,PSNACNT)=^UTILITY($J,"W",DIWL,LLL,0) S PSNACNT=PSNACNT+1
  1. S:$D(FLDX) ^TMP("PSO",$J,PSI,PSNACNT-1)=^TMP("PSO",$J,PSI,PSNACNT-1)_FS_"Patient Narrative",PSI=PSI+1
  1. K DIWF,DIWL,DIWR,LLL,PSNACNT,PSSEVFL,PSSIXFL,ZZ
  1. Q
  1. NTE3(PSI) ;Drug Warning Narrative
  1. N NTE3,J,TEXT,W,CNT,PSSWSITE
  1. S WARN=$P($G(^PSDRUG(IDGN,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(IDGN,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(OLAN)) 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. 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. NTE5(PSI) ;Drug Interactions
  1. N NTE5 D:$D(DRI) START2^PSOHLDS3
  1. S:$D(NTE5) ^TMP("PSO",$J,PSI)=NTE5_FS_"Drug Interactions",PSI=PSI+1
  1. Q
  1. NTE6(PSI) ;Drug Allergy Indications
  1. N NTE6
  1. Q:'$G(DAW)
  1. D START3^PSOHLDS3
  1. Q:NTE6=""
  1. S ^TMP("PSO",$J,PSI)=NTE6_FS_"Drug Allergy Indications",PSI=PSI+1
  1. Q
  1. NTE9(PSI) ;Privacy Notification
  1. N NTE9,PSOLAN
  1. S NTE9="NTE"_FS_9_FS_FS,^TMP("PSO",$J,PSI)=NTE9
  1. S PSOLAN=$P($G(^PS(55,DFN,"LAN")),"^",2)
  1. I PSOLAN'=2 D
  1. . S ^TMP("PSO",$J,PSI,1)="The VA Notice of Privacy Practices, IB 10-163, which outlines your privacy rights, is available online at http://www1.domain.ext/Health/ or you may obtain a copy by writing the VHA Privacy Office (19F2),"
  1. . S ^TMP("PSO",$J,PSI,2)="810 Vermont Avenue NW, Washington, DC 20420."_FS_"Privacy Notification"
  1. I PSOLAN=2 D
  1. . S ^TMP("PSO",$J,PSI,1)="La Notificacion relacionada con las Politicas de Privacidad del Departamento de Asuntos del Veterano, IB 10-163, contiene los detalles acerca de sus derechos de privacidad y esta disponsible electronicamente"
  1. . S ^TMP("PSO",$J,PSI,2)=" en la siguiente direccion: http://www1.domain.ext/Health/. Usted tambien puede conseguir una copia escribiendo a la Oficina de Privacidad del Departamento de Asuntos de Salud del Veterano, (19F2),"
  1. . S ^TMP("PSO",$J,PSI,3)="810 Vermont Avenue NW, Washington, DC 20420."_FS_"Privacy Notification"
  1. S PSI=PSI+1
  1. Q
  1. ZZZ(PSI) ;ZZZ segment for HL7 hazardous text ;*524
  1. N DRIEN,HAZD,HAZH,VAR
  1. S DRIEN=$P(^PSRX(IRXN,0),"^",6)
  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