source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLDS2.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1PSOHLDS2 ;BHAM ISC/PWC,SAB-Build HL7 Segments for automated interface ;11/22/06 3:24pm
2 ;;7.0;OUTPATIENT PHARMACY;**156,198,255,200,268**;DEC 1997;Build 9
3 ;DIWP supported by DBIA 10011
4 ;^PS(50.606 supported by DBIA 2174
5 ;^PS(50.7 supported by DBIA #2223
6 ;^PS(51 supported by DBIA 2224
7 ;^PS(51.2 supported by DBIA 2226
8 ;^PS(55 supported by DBIA 2228
9 ;^PSDRUG supported by DBIA 221
10 ;^PS(54 supported by DBIA 2227
11 ;Cont'd build HL7 segments
12 ;
13 ;*198 add check to insert spaces into PMI segments
14 ;*255 add 2 new fields to RXE.21 (label name & VA PRINT NAME)
15 ; and move NTEPMI tag to PSOHLDS4
16 ;
17RXE(PSI) ;pharmacy encoded order segment
18 Q:'$D(DFN) N RXE S RXE="" S $P(RXE,"|",1)=""""""
19 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"
20 S $P(RXE,"|",3)="" I $G(PSOXN)="" S PSOXN=""""""
21 S $P(RXE,"|",5)=PSOXN_CS_$S($G(UNIT)'="":$G(UNIT),1:"""""")_CS_"99PSU"
22 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)),"^")
23 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)),"^")
24 S TRADENM=$G(^PSRX(IRXN,"TN")),$P(RXE,"|",6)=PODOSE_CS_PODOSENM_CS_"99PSF"
25 S $P(RXE,"|",8)=MP,$P(RXE,"|",9)=TRADENM,$P(RXE,"|",10)=QTY
26 S $P(RXE,"|",11)=CS_$P($G(^PSDRUG(IDGN,660)),"^",8),$P(RXE,"|",12)=NRFL
27 S $P(RXE,"|",13)=DEAID,$P(RXE,"|",14)=VPHARMID_CS_$P(VPHARM,",",1)_CS_$P(VPHARM,",",2)
28 S $P(RXE,"|",15)=$P(^PSRX(IRXN,0),"^"),$P(RXE,"|",16)=RFRM,$P(RXE,"|",17)=NFLD
29 S $P(RXE,"|",18)=PRIORDT,$P(RXE,"|",31)=CSUB_RS_SCTALK_RS_OTLAN
30 S $P(RXE,"|",21)=CS_DRUG_RS_CS_$G(VANAME) ;*255
31 S ^TMP("PSO",$J,PSI)="RXE|"_RXE,PSI=PSI+1
32 K PODOSE,PODOSENM,POIPTR,TRADENM,UU
33 Q
34RXD(PSI) ;pharmacy dispense segment
35 Q:'$D(DFN) N RXD,I
36 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
37 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"
38 S RXD=RXD_CS_PSND1_"."_PSND3_"."_$G(IDGN)_CS_$P($G(^PSDRUG(IDGN,0)),"^")_CS_"99PSD"
39 S RXD=RXD_FS_DISPDT_FS_FS_FS_FS_$P(^PSRX(IRXN,0),"^")_FS_NRFL
40 S RXD=RXD_FS_DEA_RS_PSONDC_FS_$S(FIN'="":FIN_CS_FIN1,1:"")_FS
41 S RXD=RXD_FS_DASPLY_FS_MW_FS_FS_CS_$S($G(CAP):"NON-SAFETY",1:"SAFETY")
42 S RXD=RXD_FS_FS_FS_FS_EXDT_FS_FS_FS_FS_FS_FS_WNS_FS_FS
43 S ^TMP("PSO",$J,PSI)=RXD,PSI=PSI+1
44 Q
45RXR(PSI) ;pharmacy route segment
46 Q:'$D(DFN) N RXR S (PSROUTE,RTNAME)=""""""
47 F PSRTLP=0:0 S PSRTLP=$O(^PSRX(IRXN,6,PSRTLP)) Q:'PSRTLP D
48 .S PSROUTE=$P($G(^PSRX(IRXN,6,PSRTLP,0)),"^",7)
49 .I PSROUTE,$D(^PS(51.2,PSROUTE,0)) S RTNAME=$P(^PS(51.2,PSROUTE,0),"^")
50 I RTNAME="" K PSROUTE,RTNAME,PSRTLP Q
51 S RXR="RXR"_FS_$G(PSROUTE)_CS_$G(RTNAME)_CS_"99PSR"_FS_FS_FS_FS
52 S ^TMP("PSO",$J,PSI)=RXR,PSI=PSI+1
53 K PSROUTE,RTNAME,PSRTLP
54 Q
55SIG K OT S SGY="" F P=1:1:$L(SIG," ") S X=$P(SIG," ",P) D:X]""
56 .I $D(^PS(51,"A",X)) D
57 ..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
58 ..;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)
59 .S SGY=SGY_X_" "
60 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_" "
61SIGOLD I '$P(PSOPAR,"^",28) D K NHC
62 .K DIC,DR,DIQ,NHC S DIC=2,DA=DFN,DR=148,DIQ="NHC",DIQ(0)="I"
63 .D EN^DIQ1 K DIC,DR,DIQ
64 .I NHC(2,DFN,148,"I")="Y"!($P($G(^PS(55,DFN,40)),"^")) S SGC=SGC+1,SGY(SGC)="Expiration:________ Mfg:_________"
65 Q
66 ;
67PSOLBL3 ;RX must be defined (Internal), Check already done for OERR SIG
68 ;Format OERR Sig for New and Old label stock
69 N CTCT,FFFF,LLIM,LLLL,LVAR,LVAR1,PPP,PPPP,SGCT,SIG9,ZZZZ,PSLONG,PPPP
70 S RX=IRXN
71 I $P($G(^PS(55,DFN,"LAN")),"^") N II D OTHL^PSOLBL3 G:$G(FND) FMSIG
72 S PSLONG=$S($P(PSOPAR,"^",28):46,1:34)
73 ; NEXT LINE IF SIG IS MOVED BACK TO MULTIPLE
74 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
75 ;NEXT LINE IF 1ST FRONT DOOR SIG LINE LIVES IN BACK DOOR SPOT
76FMSIG S (LVAR,LVAR1)="",LLLL=1
77 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
78 .S LVAR1=$P(SIG9(FFFF)," ",(SGCT)),LLIM=LVAR,LVAR=$S(LVAR="":LVAR1,1:LVAR_" "_LVAR1)
79 I $G(LVAR)'="" S SGY(LLLL)=LVAR
80 I '$P(PSOPAR,"^",28) S SGC=0 F CTCT=0:0 S CTCT=$O(SGY(CTCT)) Q:'CTCT S SGC=SGC+1
81 I $O(OSGY(0)) D
82 .F I=0:0 S I=$O(SGY(I)) Q:'I I $G(OSGY(I))']"" S OSGY(I)=" "
83 .F I=0:0 S I=$O(OSGY(I)) Q:'I I $G(SGY(I))']"" S SGY(I)=" "
84 Q
85NTE ;build NTE segment for SIG
86 ;
87 Q:'$D(DFN)
88 ; 1 = SIG
89 ; 2 = PI Narrative
90 ; 3 = Drug Warning
91 ; 4 = Profile
92 ; 5 = Drug Interaction
93 ; 6 = Drug Allergy
94 ;
95 K FLDX
96 D NTE1(.PSI) K FLDX D NTE2(.PSI) K FLDX D NTE3(.PSI) K FLDX
97 D NTE4(.PSI) K FLDX D NTE5(.PSI) K FLDX D NTE6(.PSI) K FLDX
98 Q
99 ;
100NTE1(PSI) ;SIG
101 S SIG=$P($G(^PSRX(IRXN,"SIG")),"^")
102 I $P($G(^PSRX(IRXN,"SIG")),"^",2) D PSOLBL3,SIGOLD
103 I '$P($G(^PSRX(IRXN,"SIG")),"^",2) D SIG
104 I $O(OSGY(0)) D G KNTE
105 .K DRR F DR=0:0 S DR=$O(SGY(DR)) Q:'DR S DRR=$G(DRR)+1
106 .S DRR=DRR+1,SGY(DRR)=FS_"Medication Instructions (LANGUAGE PREFERENCE)"
107 .K DRR F DR=0:0 S DR=$O(OSGY(DR)) Q:'DR S DRR=$G(DRR)+1
108 .S DRR=DRR+1,OSGY(DRR)=FS_"Medication Instructions (ENGLISH)"
109 .K DRR S ^TMP("PSO",$J,PSI)="NTE"_FS_1_FS_FS
110 .S CLD=1 F DR=0:0 S DR=$O(OSGY(DR)) Q:'DR D
111 ..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)
112 .S PSI=PSI+1,^TMP("PSO",$J,PSI)="NTE"_FS_8_FS_FS
113 .S CLD=1 F DR=0:0 S DR=$O(SGY(DR)) Q:'DR D
114 ..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)
115 K DRR F DR=0:0 S DR=$O(SGY(DR)) Q:'DR S DRR=$G(DRR)+1
116 S DRR=DRR+1,SGY(DRR)=FS_"Medication Instructions"
117 K DRR S ^TMP("PSO",$J,PSI)="NTE"_FS_1_FS_FS
118 S CLD=1 F DR=0:0 S DR=$O(SGY(DR)) Q:'DR D
119 .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)
120KNTE 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
121 Q
122LENGTH(NT1) ; compensate for length > 245
123 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
124 . S:WW=1 ST=1,EN=245 S:WW>1 ST=(ST+245),EN=(EN+245) S NT11=$E(NT1,ST,EN)
125 . S:WW=1 ^TMP("PSO",$J,PSI)=NT11 S:WW>1 ^TMP("PSO",$J,PSI,WW-1)=NT11
126 S:'$D(LTH) ^TMP("PSO",$J,PSI)=NT1 S PSI=PSI+1
127 Q
128NTE2(PSI) ; Patient Narrative
129 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
130 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
131 I PSSIXFL S ^TMP("PSO",$J,PSI)="NTE"_FS_2_FS_FS,^TMP("PSO",$J,PSI,PSNACNT)=" " S PSNACNT=PSNACNT+1,FLDX=1
132 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
133 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
134 I PSSEVFL S ^TMP("PSO",$J,PSI,PSNACNT)=" " S PSNACNT=PSNACNT+1
135 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
136 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
137 S:$D(FLDX) ^TMP("PSO",$J,PSI,PSNACNT-1)=^TMP("PSO",$J,PSI,PSNACNT-1)_FS_"Patient Narrative",PSI=PSI+1
138 K DIWF,DIWL,DIWR,LLL,PSNACNT,PSSEVFL,PSSIXFL,ZZ
139 Q
140NTE3(PSI) ;Drug Warning Narrative
141 N NTE3,J,TEXT,W,CNT,PSSWSITE
142 S WARN=$P($G(^PSDRUG(IDGN,0)),"^",8)
143 S PSSWSITE=+$O(^PS(59.7,0))
144 I $P($G(^PS(59.7,PSSWSITE,10)),"^",11)="N" D
145 .S WARN=$$DRUG^PSSWRNA(IDGN,DFN)
146 I WARN="" Q
147 S NTE3="NTE"_FS_3_FS_FS,^TMP("PSO",$J,PSI)=NTE3,CNT=1
148 F J=1:1:5 S W=$P(WARN,",",J) Q:W="" D
149 . S TEXT=$$WTEXT^PSSWRNA(W,$G(OLAN)) I TEXT'="" S FLDX=1 D
150 . . I $L(TEXT)<245 S ^TMP("PSO",$J,PSI,CNT)=TEXT,CNT=CNT+1 Q
151 . . N LTH,ST,EN,TXT,WW
152 . . S LTH=$E($L(TEXT)/245,1) S:$L(TEXT)#245>0 LTH=LTH+1
153 . . F WW=1:1:LTH D
154 . . . S:WW=1 ST=1,EN=245 S:WW>1 ST=(ST+245),EN=(EN+245) S TXT=$E(TEXT,ST,EN)
155 . . . S ^TMP("PSO",$J,PSI,CNT)=TXT,CNT=CNT+1
156 I $G(FLDX) D S PSI=PSI+1
157 . 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"
158 . E S ^TMP("PSO",$J,PSI,CNT)=FS_"Drug Warning Narrative"
159 Q
160NTE4(PSI) ;Profile information
161 S PSODFN=DFN N NTE4
162 I $P(PSOPAR,"^",8) D START^PSOHLDS3
163 S:$D(NTE4) PSI=PSI+1
164 Q
165NTE5(PSI) ;Drug Interactions
166 N NTE5 D:$D(DRI) START2^PSOHLDS3
167 S:$D(NTE5) ^TMP("PSO",$J,PSI)=NTE5_FS_"Drug Interactions",PSI=PSI+1
168 Q
169NTE6(PSI) ;Drug Allergy Indications
170 N NTE6
171 Q:'$G(DAW)
172 D START3^PSOHLDS3
173 Q:NTE6=""
174 S ^TMP("PSO",$J,PSI)=NTE6_FS_"Drug Allergy Indications",PSI=PSI+1
175 Q
Note: See TracBrowser for help on using the repository browser.