source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLDS2.m@ 1464

PSOHLDS2 ;BHAM ISC/PWC,SAB-Build HL7 Segments for automated interface ;11/22/06 3:24pm
 ;;7.0;OUTPATIENT PHARMACY;**156,198,255,200,268**;DEC 1997;Build 9
 ;DIWP supported by DBIA 10011
 ;^PS(50.606 supported by DBIA 2174
 ;^PS(50.7 supported by DBIA #2223
 ;^PS(51 supported by DBIA 2224
 ;^PS(51.2 supported by DBIA 2226
 ;^PS(55 supported by DBIA 2228
 ;^PSDRUG supported by DBIA 221
 ;^PS(54 supported by DBIA 2227
 ;Cont'd build HL7 segments
 ;
 ;*198 add check to insert spaces into PMI segments
 ;*255 add 2 new fields to RXE.21 (label name & VA PRINT NAME)
 ;     and move NTEPMI tag to PSOHLDS4
 ;
RXE(PSI) ;pharmacy encoded order segment
 Q:'$D(DFN)  N RXE S RXE="" S $P(RXE,"|",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"
 S $P(RXE,"|",3)="" I $G(PSOXN)="" S PSOXN=""""""
 S $P(RXE,"|",5)=PSOXN_CS_$S($G(UNIT)'="":$G(UNIT),1:"""""")_CS_"99PSU"
 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)),"^")
 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)),"^")
 S TRADENM=$G(^PSRX(IRXN,"TN")),$P(RXE,"|",6)=PODOSE_CS_PODOSENM_CS_"99PSF"
 S $P(RXE,"|",8)=MP,$P(RXE,"|",9)=TRADENM,$P(RXE,"|",10)=QTY
 S $P(RXE,"|",11)=CS_$P($G(^PSDRUG(IDGN,660)),"^",8),$P(RXE,"|",12)=NRFL
 S $P(RXE,"|",13)=DEAID,$P(RXE,"|",14)=VPHARMID_CS_$P(VPHARM,",",1)_CS_$P(VPHARM,",",2)
 S $P(RXE,"|",15)=$P(^PSRX(IRXN,0),"^"),$P(RXE,"|",16)=RFRM,$P(RXE,"|",17)=NFLD
 S $P(RXE,"|",18)=PRIORDT,$P(RXE,"|",31)=CSUB_RS_SCTALK_RS_OTLAN
 S $P(RXE,"|",21)=CS_DRUG_RS_CS_$G(VANAME)                       ;*255
 S ^TMP("PSO",$J,PSI)="RXE|"_RXE,PSI=PSI+1
 K PODOSE,PODOSENM,POIPTR,TRADENM,UU
 Q
RXD(PSI) ;pharmacy dispense segment
 Q:'$D(DFN)  N RXD,I
 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
 S RXD="RXD"_FS_$S($G(NFLD):NFLD,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"
 S RXD=RXD_CS_PSND1_"."_PSND3_"."_$G(IDGN)_CS_$P($G(^PSDRUG(IDGN,0)),"^")_CS_"99PSD"
 S RXD=RXD_FS_DISPDT_FS_FS_FS_FS_$P(^PSRX(IRXN,0),"^")_FS_NRFL
 S RXD=RXD_FS_DEA_RS_PSONDC_FS_$S(FIN'="":FIN_CS_FIN1,1:"")_FS
 S RXD=RXD_FS_DASPLY_FS_MW_FS_FS_CS_$S($G(CAP):"NON-SAFETY",1:"SAFETY")
 S RXD=RXD_FS_FS_FS_FS_EXDT_FS_FS_FS_FS_FS_FS_WNS_FS_FS
 S ^TMP("PSO",$J,PSI)=RXD,PSI=PSI+1
 Q
RXR(PSI) ;pharmacy route segment
 Q:'$D(DFN)  N RXR S (PSROUTE,RTNAME)=""""""
 F PSRTLP=0:0 S PSRTLP=$O(^PSRX(IRXN,6,PSRTLP)) Q:'PSRTLP  D
 .S PSROUTE=$P($G(^PSRX(IRXN,6,PSRTLP,0)),"^",7)
 .I PSROUTE,$D(^PS(51.2,PSROUTE,0))  S RTNAME=$P(^PS(51.2,PSROUTE,0),"^")
 I RTNAME="" K PSROUTE,RTNAME,PSRTLP Q
 S RXR="RXR"_FS_$G(PSROUTE)_CS_$G(RTNAME)_CS_"99PSR"_FS_FS_FS_FS
 S ^TMP("PSO",$J,PSI)=RXR,PSI=PSI+1
 K PSROUTE,RTNAME,PSRTLP
 Q
SIG K OT S SGY="" F P=1:1:$L(SIG," ") S X=$P(SIG," ",P) D:X]""
 .I $D(^PS(51,"A",X)) D
 ..I $P($G(^PS(55,DFN,"LAN")),"^") S OT=$O(^PS(51,"B",X,0)) I OT,$P($G(^PS(51,OT,4)),"^")]"" S X=$P(^PS(51,OT,4),"^") K OT Q
 ..;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)
 .S SGY=SGY_X_" "
 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_" "
SIGOLD I '$P(PSOPAR,"^",28) D  K NHC
 .K DIC,DR,DIQ,NHC S DIC=2,DA=DFN,DR=148,DIQ="NHC",DIQ(0)="I"
 .D EN^DIQ1 K DIC,DR,DIQ
 .I NHC(2,DFN,148,"I")="Y"!($P($G(^PS(55,DFN,40)),"^")) S SGC=SGC+1,SGY(SGC)="Expiration:________ Mfg:_________"
 Q
 ;
PSOLBL3 ;RX must be defined (Internal), Check already done for OERR SIG
 ;Format OERR Sig for New and Old label stock
 N CTCT,FFFF,LLIM,LLLL,LVAR,LVAR1,PPP,PPPP,SGCT,SIG9,ZZZZ,PSLONG,PPPP
 S RX=IRXN
 I $P($G(^PS(55,DFN,"LAN")),"^") N II D OTHL^PSOLBL3 G:$G(FND) FMSIG
 S PSLONG=$S($P(PSOPAR,"^",28):46,1:34)
 ; NEXT LINE IF SIG IS MOVED BACK TO MULTIPLE
 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
 ;NEXT LINE IF 1ST FRONT DOOR SIG LINE LIVES IN BACK DOOR SPOT
FMSIG S (LVAR,LVAR1)="",LLLL=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
 .S LVAR1=$P(SIG9(FFFF)," ",(SGCT)),LLIM=LVAR,LVAR=$S(LVAR="":LVAR1,1:LVAR_" "_LVAR1)
 I $G(LVAR)'="" S SGY(LLLL)=LVAR
 I '$P(PSOPAR,"^",28) S SGC=0 F CTCT=0:0 S CTCT=$O(SGY(CTCT)) Q:'CTCT  S SGC=SGC+1
 I $O(OSGY(0)) D
 .F I=0:0 S I=$O(SGY(I)) Q:'I  I $G(OSGY(I))']"" S OSGY(I)=" "
 .F I=0:0 S I=$O(OSGY(I)) Q:'I  I $G(SGY(I))']"" S SGY(I)=" "
 Q
NTE ;build NTE segment for SIG
 ;
 Q:'$D(DFN)
 ; 1 = SIG
 ; 2 = PI Narrative
 ; 3 = Drug Warning
 ; 4 = Profile
 ; 5 = Drug Interaction
 ; 6 = Drug Allergy
 ;
 K FLDX
 D NTE1(.PSI) K FLDX D NTE2(.PSI) K FLDX D NTE3(.PSI) K FLDX
 D NTE4(.PSI) K FLDX D NTE5(.PSI) K FLDX D NTE6(.PSI) K FLDX
 Q
 ;
NTE1(PSI) ;SIG
 S SIG=$P($G(^PSRX(IRXN,"SIG")),"^")
 I $P($G(^PSRX(IRXN,"SIG")),"^",2) D PSOLBL3,SIGOLD
 I '$P($G(^PSRX(IRXN,"SIG")),"^",2) D SIG
 I $O(OSGY(0)) D  G KNTE
 .K DRR F DR=0:0 S DR=$O(SGY(DR)) Q:'DR  S DRR=$G(DRR)+1
 .S DRR=DRR+1,SGY(DRR)=FS_"Medication Instructions (LANGUAGE PREFERENCE)"
 .K DRR F DR=0:0 S DR=$O(OSGY(DR)) Q:'DR  S DRR=$G(DRR)+1
 .S DRR=DRR+1,OSGY(DRR)=FS_"Medication Instructions (ENGLISH)"
 .K DRR S ^TMP("PSO",$J,PSI)="NTE"_FS_1_FS_FS
 .S CLD=1 F DR=0:0 S DR=$O(OSGY(DR)) Q:'DR  D
 ..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)
 .S PSI=PSI+1,^TMP("PSO",$J,PSI)="NTE"_FS_8_FS_FS
 .S CLD=1 F DR=0:0 S DR=$O(SGY(DR)) Q:'DR  D
 ..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)
 K DRR F DR=0:0 S DR=$O(SGY(DR)) Q:'DR  S DRR=$G(DRR)+1
 S DRR=DRR+1,SGY(DRR)=FS_"Medication Instructions"
 K DRR S ^TMP("PSO",$J,PSI)="NTE"_FS_1_FS_FS
 S CLD=1 F DR=0:0 S DR=$O(SGY(DR)) Q:'DR  D
 .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)
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
 Q
LENGTH(NT1) ; compensate for length > 245
 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
 . S:WW=1 ST=1,EN=245 S:WW>1 ST=(ST+245),EN=(EN+245) S NT11=$E(NT1,ST,EN)
 . S:WW=1 ^TMP("PSO",$J,PSI)=NT11 S:WW>1 ^TMP("PSO",$J,PSI,WW-1)=NT11
 S:'$D(LTH) ^TMP("PSO",$J,PSI)=NT1 S PSI=PSI+1
 Q
NTE2(PSI) ; Patient Narrative
 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
 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
 I PSSIXFL S ^TMP("PSO",$J,PSI)="NTE"_FS_2_FS_FS,^TMP("PSO",$J,PSI,PSNACNT)=" " S PSNACNT=PSNACNT+1,FLDX=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
 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
 I PSSEVFL S ^TMP("PSO",$J,PSI,PSNACNT)=" " S PSNACNT=PSNACNT+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
 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
 S:$D(FLDX) ^TMP("PSO",$J,PSI,PSNACNT-1)=^TMP("PSO",$J,PSI,PSNACNT-1)_FS_"Patient Narrative",PSI=PSI+1
 K DIWF,DIWL,DIWR,LLL,PSNACNT,PSSEVFL,PSSIXFL,ZZ
 Q
NTE3(PSI) ;Drug Warning Narrative
 N NTE3,J,TEXT,W,CNT,PSSWSITE
 S WARN=$P($G(^PSDRUG(IDGN,0)),"^",8)
 S PSSWSITE=+$O(^PS(59.7,0))
 I $P($G(^PS(59.7,PSSWSITE,10)),"^",11)="N" D
 .S WARN=$$DRUG^PSSWRNA(IDGN,DFN)
 I WARN="" Q
 S NTE3="NTE"_FS_3_FS_FS,^TMP("PSO",$J,PSI)=NTE3,CNT=1
 F J=1:1:5 S W=$P(WARN,",",J) Q:W=""  D
 . S TEXT=$$WTEXT^PSSWRNA(W,$G(OLAN)) 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
NTE5(PSI) ;Drug Interactions
 N NTE5 D:$D(DRI) START2^PSOHLDS3
 S:$D(NTE5) ^TMP("PSO",$J,PSI)=NTE5_FS_"Drug Interactions",PSI=PSI+1
 Q
NTE6(PSI) ;Drug Allergy Indications
 N NTE6
 Q:'$G(DAW)
 D START3^PSOHLDS3
 Q:NTE6=""
 S ^TMP("PSO",$J,PSI)=NTE6_FS_"Drug Allergy Indications",PSI=PSI+1
 Q