source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORRDI.m@ 812

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1PSOORRDI ;BHAM-ISC/EJW - Remote Data Interoperability Order Checks ;04/25/05
2 ;;7.0;OUTPATIENT PHARMACY;**207,243**;DEC 1997;Build 22
3 ;
4 ;External references to ^ORRDI1 supported by DBIA 4659
5 ;External references to ^XTMP("ORRDI" supported by DBIA 4660
6 ;External reference to ^PS(50.605 supported by DBIA 696
7 ;External reference to ^PSDRUG supported by DBIA 221
8 ;External reference to ^PS(56 supported by DBIA 2229
9 ;External reference to ^PS(50.416 supported by DBIA 692
10 ;External reference to DDIEX^PSNAPIS supported by DBIA 2574
11REMOTE(PSODFN,DREN) ;
12 ; Input: DFN: PATIENT file (#2) IEN
13 ; : DREN: DRUG file (#50) IEN of order being checked
14 I $T(HAVEHDR^ORRDI1)']"" Q
15 I '$$HAVEHDR^ORRDI1 Q
16 I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) Q
17 N PSORDI,RDIINST,RDIVUID,RDIRX,RDIDNAM,RDISTA,RDISIG,RDIDAYS,RDIQTY,RDIFILL,RDIEXP,RDIISS,RDIFILL,RDIREF,RDIPHYS,PSOPROD,PSOCLASS,DRNM,RDITMP,PSODC,IT,PSOICT,NDF,RDIDI,PSOPRODA,PSOFILE,PSOSIG
18 I '$G(DT) S DT=$$DT^XLFDT
19 S PSORDI=0
20 I $T(GET^ORRDI1)]"" S PSORDI=$$GET^ORRDI1(PSODFN,"PSOO")
21 I PSORDI<1 Q
22 I '$D(^XTMP("ORRDI","PSOO",PSODFN)) Q
23 K ^TMP($J,"PSORDI")
24 D PARSE,FILTER
25 I '$D(^TMP($J,"PSORDI")) Q
26 D DRGNAME ; GET VA PRODUCT FILE NAME FOR FILE 50 DRUG BEING CHECKED
27 S PSORDI="" F S PSORDI=$O(^TMP($J,"PSORDI",PSORDI)) Q:'PSORDI S RDITMP=^(PSORDI) D
28 .S RDIINST=$P(RDITMP,"^")
29 .S RDIVUID=$P(RDITMP,"^",2)
30 .I RDIVUID="" Q
31 .S RDIDNAM=$P(RDITMP,"^",3)
32 .S RDISTA=$P(RDITMP,"^",4)
33 .S RDIRX=$P(RDITMP,"^",5)
34 .S RDIFILL=$P(RDITMP,"^",6)
35 .S RDIDAYS=$P(RDITMP,"^",7) I $E(RDIDAYS)="D" S RDIDAYS=$P(RDIDAYS,"D",2)
36 .S RDIQTY=$P(RDITMP,"^",8)
37 .S RDIREF=$P(RDITMP,"^",9)
38 .S RDIEXP=$P(RDITMP,"^",10)
39 .S RDIPHYS=$P(RDITMP,"^",11)
40 .S RDIISS=$P(RDITMP,"^",12)
41 .S DRNM=$G(PSODRUG("NAME"))
42 .D GETPROD
43 .I DRNM'="" I PSODRUG("NAME")=DRNM S DD=$G(DD)+1,^TMP($J,"DD",DD,0)=PSODRUG("IEN")_"^"_PSODRUG("NAME")_"^"_"^"_RDIRX_"R;O"_"^"_RDIINST D Q:'$G(PSOPHI)
44 ..S ^TMP($J,"DD",DD,1)=RDIDNAM_"^"_RDISTA_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
45 ..M ^TMP($J,"DD",DD,1)=^TMP($J,"PSORDI",PSORDI,"SIG")
46 .I PSODRUG("NAME")'=DRNM I PSODRUG("VA CLASS")]"",$E(PSODRUG("VA CLASS"),1,4)=$E(PSOCLASS,1,4) D
47 ..I $E(PSODRUG("VA CLASS"),1,2)="HA",$E(PSOCLASS,1,2)="HA" Q
48 ..S PSODC=$O(^PS(50.605,"B",PSODRUG("VA CLASS"),0)) Q:'PSODC
49 ..S DC=$G(DC)+1,^TMP($J,"DC",DC,0)=PSODRUG("VA CLASS")
50 ..S PSODC=$P(^PS(50.605,PSODC,0),"^",2),^TMP($J,"DC",DC,0)=^TMP($J,"DC",DC,0)_"^"_PSODC_"^"_RDIVUID_"^"_DRNM_"^"_"^"_RDIRX_"R;O"_"^"_RDIINST D
51 ...S ^TMP($J,"DC",DC,1)=RDIDNAM_"^"_RDISTA_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
52 ...M ^TMP($J,"DC",DC,1)=^TMP($J,"PSORDI",PSORDI,"SIG")
53 .;drug interaction check
54 .K ^TMP($J,"PSOPROD")
55 .D DATA^PSN50P68(PSOPROD,,"PSOPROD")
56 .S NDF=+$G(^TMP($J,"PSOPROD",PSOPROD,.05))
57 .I NDF=0 Q
58 .S NDF=NDF_"A"_PSOPROD
59 .K ^TMP($J,"PSOPROD")
60 .S IT=0,PSOICT=""
61 .F S IT=$O(^PS(56,"APD",NDF,PSODRUG("NDF"),IT)) Q:'IT D
62 ..Q:$$DDIEX^PSNAPIS($P(NDF,"A"),$P(NDF,"A",2))
63 ..Q:$$DDIEX^PSNAPIS($P(PSODRUG("NDF"),"A"),$P(PSODRUG("NDF"),"A",2))
64 ..Q:$P(^PS(56,IT,0),"^",7)&($P(^PS(56,IT,0),"^",7)<DT)
65 ..I 'PSOICT S PSOICT=IT Q
66 ..I $P($G(^PS(56,IT,0)),"^",4)=1 S PSOICT=IT Q
67 ..Q
68 .I 'PSOICT Q
69 .S IT=PSOICT
70 .S RDIDI=$O(^TMP($J,"DI",999),-1) I 'RDIDI S RDIDI=0
71 .S RDIDI=$G(RDIDI)+1,^TMP($J,"DI",RDIDI,0)=RDIVUID_"^"_DRNM_"^"_IT_"^"_$S($P(^PS(56,IT,0),"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"^"
72 .S ^TMP($J,"DI",RDIDI,0)=^TMP($J,"DI",RDIDI,0)_$P(^PS(50.416,$P(^PS(56,IT,0),"^",2),0),"^")_"^"_$P(^PS(50.416,$P(^PS(56,IT,0),"^",3),0),"^")_"^"_""_"^"_RDIRX_"R;O"_"^"_RDIINST
73 .S ^TMP($J,"DI",RDIDI,1)=RDIDNAM_"^"_RDISTA_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
74 .M ^TMP($J,"DI",RDIDI,1)=^TMP($J,"PSORDI",PSORDI,"SIG")
75 .M ^TMP($J,"DI"_PSODFN,RDIDI)=^TMP($J,"DI",RDIDI) ; SAVE FOR OUTPATIENT PHARMACY BACKDOOR DISPLAY
76 K ^TMP($J,"PSORDI")
77 Q
78 ;
79PARSE ; PULL INFORMATION FROM ^XTMP
80 N PSORDI,LOCAL,NEWISS,BADEXP,PSOPRE,PSO30,NEWDC,NEWEXP
81 S PSORDI=0 F S PSORDI=$O(^XTMP("ORRDI","PSOO",PSODFN,PSORDI)) Q:'PSORDI D
82 .S RDISTA=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,5,0))
83 .I RDISTA="DELETED" Q
84 .S RDIINST=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,1,0))
85 .S RDIDNAM=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,2,0))
86 .S RDIVUID=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,3,0))
87 .I RDIVUID="" Q
88 .S RDIRX=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,4,0))
89 .S RDIQTY=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,6,0)),RDIDAYS=$P(RDIQTY,";",2),RDIQTY=$P(RDIQTY,";")
90 .I $E(RDIDAYS)="D" S RDIDAYS=$P(RDIDAYS,"D",2)
91 .S RDIEXP=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,7,0))
92 .S RDIISS=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,8,0))
93 .I RDIEXP?."/" S BADEXP=1 D I BADEXP Q
94 ..I RDIISS?."/" Q
95 ..S PSOPRE=$E(DT) I $P(RDIISS,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1
96 ..S NEWISS=PSOPRE_$P(RDIISS,"/",3)_$P(RDIISS,"/")_$P(RDIISS,"/",2) I NEWISS>(DT-10000) S RDIEXP=RDIISS,BADEXP=0
97 .I RDISTA["EXPIRE" S PSO30=0 D I PSO30 Q
98 ..S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSO30=1 Q
99 ..S NEWEXP=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2)
100 ..S X1=NEWEXP,X2=30 D C^%DTC I X<DT S PSO30=1
101 .I RDIRX'="" S LOCAL=0 D CHKLOCAL I LOCAL Q
102 .S RDIFILL=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,9,0))
103 .I RDISTA["DISCONT" S PSO30=0 D I PSO30 Q
104 ..S PSOPRE=$E(DT) I $P(RDIFILL,"/",3)>($E(DT,2,3)+1) S PSO30=1 Q
105 ..S NEWDC=PSOPRE_$P(RDIFILL,"/",3)_$P(RDIFILL,"/")_$P(RDIFILL,"/",2)
106 ..S X1=NEWDC,X2=30+RDIDAYS D C^%DTC I X<DT S PSO30=1
107 .S RDIREF=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,10,0))
108 .S RDIPHYS=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,11,0))
109 .S PSOSIG="" F S PSOSIG=$O(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,14,PSOSIG)) Q:PSOSIG="" S PSOSIG(PSOSIG)=^(PSOSIG)
110 .S ^TMP($J,"PSORDI",PSORDI)=RDIINST_"^"_RDIVUID_"^"_RDIDNAM_"^"_RDISTA_"^"_RDIRX_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
111 .S PSOSIG="" F S PSOSIG=$O(PSOSIG(PSOSIG)) Q:PSOSIG="" S ^TMP($J,"PSORDI",PSORDI,"SIG",PSOSIG)=PSOSIG(PSOSIG)
112 Q
113 ;
114CHKLOCAL ; IF SAME RX NUMBER AND ISSUE DATE - LOCAL RX
115 N PSOISS
116 I $D(^PSRX("B",RDIRX)) D
117 .N PSORX
118 .S PSORX=$O(^PSRX("B",RDIRX,"")) I 'PSORX Q
119 .S PSOISS=$P($G(^PSRX(PSORX,0)),"^",13)
120 .S PSOISS=$E(PSOISS,4,5)_"/"_$E(PSOISS,6,7)_"/"_$E(PSOISS,2,3)
121 .I PSOISS=RDIISS S LOCAL=1 Q
122 Q
123 ;
124VAPROD(PSOPROD) ; GET VA PRODUCT FILE NAME AND DRUG CLASS
125 S PSOCLASS=$$DCLCODE^PSNAPIS(,PSOPROD)
126 S DRNM=$P($$PROD0^PSNAPIS(,PSOPROD),"^")
127 Q
128 ;
129DRGNAME ;
130 N PSOY
131 S PSOY=DREN_"^"_$P($G(^PSDRUG(DREN,0)),"^"),PSOY(0)=$G(^PSDRUG(DREN,0))
132 S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2)
133 S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
134 I PSODRUG("NDF")=0 Q
135 S PSOPROD=$P(PSODRUG("NDF"),"A",2) I PSOPROD D VAPROD(PSOPROD) S PSODRUG("NAME")=DRNM
136 Q
137 ;
138FILTER ; FOR SAME DRUG VUID FOR SAME SITE, KEEP 1 ENTRY - CHECK BY ACTIVE STATUS FIRST THEN BY GREATEST EXPIRATION DATE
139 N XX,RDI,OLDEXP,RDIEXP,RDIEXP2,OLDEXP2,PSORDI,RDISTA,OLDSTA,OLDRDI,ZZ
140 S PSORDI=0
141 F S PSORDI=$O(^TMP($J,"PSORDI",PSORDI)) Q:'PSORDI D
142 .S XX=$G(^TMP($J,"PSORDI",PSORDI)),RDIINST=$P(XX,"^"),RDIVUID=$P(XX,"^",2),RDISTA=$P(XX,"^",4),RDIEXP=$P(XX,"^",10) Q:RDIINST="" Q:RDIVUID="" I RDIEXP="" Q
143 .I $D(RDI(RDIINST,RDIVUID)) S ZZ=RDI(RDIINST,RDIVUID) D Q
144 ..I RDISTA="ACTIVE"!(RDISTA["SUSPEN") D Q
145 ...S OLDSTA=$P(ZZ,"^",2) I OLDSTA["ACTIVE"!(OLDSTA["SUSPEN") D CHKEXP Q
146 ...S OLDRDI=$P(ZZ,"^") K ^TMP($J,"PSORDI",OLDRDI) D SETRDI
147 ..S OLDSTA=$P(ZZ,"^",2) I OLDSTA["ACTIVE"!(OLDSTA["SUSPEN") K ^TMP($J,"PSORDI",PSORDI) Q
148 ..D CHKEXP ; ALL OTHER STATUSES - KEEP BY GREATER EXPIRATION DATE
149 .D SETRDI
150 Q
151 ;
152CHKEXP ;
153 N PSOPRE
154 S OLDEXP=$P(ZZ,"^",3) D I OLDEXP2>RDIEXP2 K ^TMP($J,"PSORDI",PSORDI) Q
155 .S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1
156 .S RDIEXP2=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2)
157 .S PSOPRE=$E(DT) I $P(OLDEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1
158 .S OLDEXP2=PSOPRE_$P(OLDEXP,"/",3)_$P(OLDEXP,"/")_$P(OLDEXP,"/",2)
159 S OLDRDI=$P(ZZ,"^") K ^TMP($J,"PSORDI",OLDRDI) D SETRDI
160 Q
161 ;
162SETRDI ;
163 S RDI(RDIINST,RDIVUID)=PSORDI_"^"_RDISTA_"^"_RDIEXP
164 Q
165 ;
166GETPROD ;
167 S PSOFILE=50.68
168 S DRNM="",PSOCLASS="",PSOPROD=0
169 N PSOPR
170 K PSOPRODA
171 N DIC
172 D GETIREF^XTID(PSOFILE,.01,RDIVUID,"PSOPRODA",1) I 'PSOPRODA Q
173 S PSOPR="" F S PSOPR=$O(PSOPRODA(PSOFILE,.01,PSOPR)) Q:PSOPR="" D Q:DRNM'="" Q:PSOCLASS'=""
174 .I +(PSOPRODA(PSOFILE,.01,PSOPR)) S PSOPROD=+PSOPR D VAPROD(PSOPROD) Q
175 .I +(PSOPRODA(PSOFILE,.01,PSOPR))=0 I '$O(PSOPRODA(PSOFILE,.01,PSOPR)) S PSOPROD=+PSOPR D VAPROD(PSOPROD) ; USE LAST ENTRY IF ALL ARE INACTIVE
176 Q
177 ;
Note: See TracBrowser for help on using the repository browser.