source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORDRG.m@ 699

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

initial load of WorldVistAEHR

File size: 7.2 KB
Line 
1PSOORDRG ;BIR/SAB - order entry drug selection ;11/13/97
2 ;;7.0;OUTPATIENT PHARMACY;**3,29,49,46,81,105,134,144,132,188,207,148,243**;DEC 1997;Build 22
3 ;External references to ^PSJORUT2 supported by DBIA 2376
4 ;External reference to ^PS(50.7 supported by DBIA 2223
5 ;External reference to ^PS(50.605 supported by DBIA 696
6 ;External reference to ^PSDRUG supported by DBIA 221
7 ;External reference to ^PS(55 supported by DBIA 2228
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
11 ;External references to ^ORRDI1 supported by DBIA 4659
12 ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
13 ;
14EN(PSODFN,DREN) ;
15 K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"_PSODFN),PSOPHI S INDX=0
16 ;build patient's drug profile outpat/inpat/non-va
17 D BLD,ENCHK^PSJORUT2(PSODFN,.INDX),NVA
18 ;collect drug info
19DRG ;S X=DREN,DIC="^PSDRUG(",DIC(0)="MQNZO" D ^DIC K DIC,PSOY Q:Y<1 S PSOY=Y,PSOY(0)=Y(0) K X,Y
20 N PSOICT S PSOICT=""
21 S PSOY=DREN_"^"_$P($G(^PSDRUG(DREN,0)),"^"),PSOY(0)=$G(^PSDRUG(DREN,0)) K X,Y
22 S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2),PSODRUG("NAME")=$P(PSOY(0),"^")
23 S:+$G(^PSDRUG(+PSOY,2)) PSODRUG("OI")=+$G(^(2)),PSODRUG("OIN")=$P(^PS(50.7,+$G(^(2)),0),"^")
24 S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
25 S PSODRUG("MAXDOSE")=$P(PSOY(0),"^",4),PSODRUG("DEA")=$P(PSOY(0),"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(+PSOY,"ND")):+$P(^("ND"),"^",6),1:0)
26 S PSODRUG("SIG")=$P(PSOY(0),"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$G(PSOSITE))
27 S PSODRUG("DAW")=$$GET1^DIQ(50,+PSOY,81)
28 S PSOX1=$G(^PSDRUG(+PSOY,660)),PSODRUG("COST")=$P($G(PSOX1),"^",6),PSODRUG("UNIT")=$P($G(PSOX1),"^",8),PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9)
29 K PSOX1,PSOY Q:$G(POERR)
30 ;dup drug/class check
31 S DNM=0 F S DNM=$O(^TMP($J,"ORDERS",DNM)) Q:'DNM D
32 .S DRNM=$P(^TMP($J,"ORDERS",DNM),"^",3)
33 .I PSODRUG("NAME")=DRNM S DD=$G(DD)+1,^TMP($J,"DD",DD,0)=PSODRUG("IEN")_"^"_PSODRUG("NAME")_"^"_$P(^TMP($J,"ORDERS",DNM),"^",4)_"^"_$P(^(DNM),"^",5) Q:'$G(PSOPHI)
34 .I PSODRUG("VA CLASS")]"",$E(PSODRUG("VA CLASS"),1,4)=$E($P(^TMP($J,"ORDERS",DNM),"^"),1,4),DRNM'=PSODRUG("NAME") D
35 ..I $E(PSODRUG("VA CLASS"),1,2)="HA",$E($P(^TMP($J,"ORDERS",DNM),"^"),1,2)="HA" Q
36 ..S PSODC=$O(^PS(50.605,"B",PSODRUG("VA CLASS"),0)) Q:'PSODC
37 ..S DC=$G(DC)+1,^TMP($J,"DC",DC,0)=PSODRUG("VA CLASS")
38 ..S PSODC=$P(^PS(50.605,PSODC,0),"^",2),^TMP($J,"DC",DC,0)=^TMP($J,"DC",DC,0)_"^"_PSODC_"^"_$O(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_$P(^TMP($J,"ORDERS",DNM),"^",4)_"^"_$P(^(DNM),"^",5)
39 ;drug interaction check
40 S DRG=0
41 F S DRG=$O(^TMP($J,"ORDERS",DRG)) Q:'DRG S NDF=$P(^TMP($J,"ORDERS",DRG),"^",2) D
42 .S IT=0,PSOICT=""
43 .F S IT=$O(^PS(56,"APD",NDF,PSODRUG("NDF"),IT)) Q:'IT D
44 ..Q:$$DDIEX^PSNAPIS($P(NDF,"A"),$P(NDF,"A",2))
45 ..Q:$$DDIEX^PSNAPIS($P(PSODRUG("NDF"),"A"),$P(PSODRUG("NDF"),"A",2))
46 ..Q:$P(^PS(56,IT,0),"^",7)&($P(^PS(56,IT,0),"^",7)<DT)
47 ..I 'PSOICT S PSOICT=IT Q
48 ..I $P($G(^PS(56,IT,0)),"^",4)=1 S PSOICT=IT Q
49 ..Q
50 .I 'PSOICT Q
51 .S IT=PSOICT
52 .S DRNM=$P(^TMP($J,"ORDERS",DRG),"^",3),ORN=$P(^(DRG),"^",4),RXN=$P(^(DRG),"^",5)
53 .S DI=$G(DI)+1,^TMP($J,"DI",DI,0)=$O(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_IT_"^"_$S($P(^PS(56,IT,0),"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"^"
54 .S ^TMP($J,"DI",DI,0)=^TMP($J,"DI",DI,0)_$P(^PS(50.416,$P(^PS(56,IT,0),"^",2),0),"^")_"^"_$P(^PS(50.416,$P(^PS(56,IT,0),"^",3),0),"^")_"^"_ORN_"^"_RXN
55 D REMOTE
56 Q:$G(PSOPHI)
57EXIT K ^TMP($J,"ORDERS"),DFN,DA,DNM,DUPRX0,RX,Y,ZZ,PSOCLOZ,PSOY,DRG,DNM,DD,DI,DC,IT,PSODRUG,PSOY,ORN,DRNM
58 K PSOX,EXPDT,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,RXN
59 Q
60BLD K ^TMP($J,"ORDERS") I '$D(PSODFN)!('$D(DT)) G EXIT
61 S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X D BUILD G GETX
62 Q
63BUILD ;build profiles
64 S EXPDT=PSODTCUT-1,RX=0
65 F S EXPDT=$O(^PS(55,PSODFN,"P","A",EXPDT)) Q:'EXPDT F S RX=$O(^PS(55,PSODFN,"P","A",EXPDT,RX)) Q:'RX I $D(^PSRX(RX,0)) D GET
66 S EN=0
67 F PSOEN=0:0 S PSOEN=$O(^PS(52.41,"AOR",PSODFN,PSOEN)) Q:'PSOEN D
68 .F S EN=$O(^PS(52.41,"AOR",PSODFN,PSOEN,EN)) Q:'EN D
69 ..S PSOOI=^PS(52.41,EN,0) I $P(PSOOI,"^",3)'="DC"&($P(PSOOI,"^",3)'="DE") D:'$P(^PS(52.41,EN,0),"^",9) BLDOI I $P(^PS(52.41,EN,0),"^",9) S PSODD=+$P(PSOOI,"^",9) D SETTMP
70 D BUILDX
71 Q
72 ;
73BLDOI ;If no DD/non-standard dose, get all drugs for OI
74 N PSOI S PSOI=$P(PSOOI,"^",8) Q:'PSOOI
75 S PSODD="" F S PSODD=$O(^PSDRUG("ASP",PSOI,PSODD)) Q:'PSODD D SETTMP
76 Q
77 ;
78SETTMP ;Create ^TMP($J,"ORDERS"
79 Q:$P(PSOOI,"^",3)="RF"
80 S DRG=$S(PSODD:$P($G(^PSDRUG(PSODD,0)),"^"),1:"") Q:DRG']""
81 S INDX=$G(INDX)+1,^TMP($J,"ORDERS",INDX)=$S(PSODD:$P(^PSDRUG(PSODD,0),"^",2),1:"")_"^"_$S($G(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)_"^"_DRG_"^"_$P(^PS(52.41,EN,0),"^")_"^"_EN_"P;O"
82 Q
83 ;
84BUILDX K EN,PSOOI,PSODD,PSOEN Q
85 ;
86GET ;data for profiles
87 S PSORX0=^PSRX(RX,0),PSOST0=+^("STA") Q:PSOST0>5&(PSOST0'=16)
88 S PSORX2=$G(^PSRX(RX,2)),PSORX3=$G(^(3)),ORN=$P($G(^("OR1")),"^",2) S:PSORX3="" PSORX3=$P(PSORX2,"^",2)
89 S PSODRUG=+$P(PSORX0,"^",6) Q:'$D(^PSDRUG(PSODRUG,0))
90 S PSODRUG0=^PSDRUG(PSODRUG,0),PSOVACL=$P(PSODRUG0,"^",2)
91 ;
92 I EXPDT<DT D
93 .N DIE,DIC,DR,DA S STAT="SC",DIE=52,DA=RX,DR="100////11" D ^DIE K DIE,DIC,DR,DA
94 .D ECAN^PSOUTL(RX) S DA=RX
95 .S COMM="Prescription Expired",PHARMST="ZE" D EN^PSOHLSN1(DA,STAT,PHARMST,COMM)
96 S INDX=$G(INDX)+1
97 S ^TMP($J,"ORDERS",INDX)=PSOVACL_"^"_$S($G(^PSDRUG(PSODRUG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)_"^"_$P(^PSDRUG(PSODRUG,0),"^")_"^"_ORN_"^"_RX_"R;O"
98 Q
99GETX ;
100 K PSOX,EXPDT,PSODRUG,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,ORN
101 Q
102CLOZ ;
103 S ANQRTN=$P(^PSDRUG(PSODRUG("IEN"),"CLOZ1"),"^"),ANQX=0,P(5)=PSODRUG("IEN"),DFN=PSODFN,X=ANQRTN
104 X ^%ZOSF("TEST") I D @("^"_ANQRTN) S:$G(ANQX) PSORX("DFLG")=1
105 K P(5),ANQRTN,ANQX,X
106 Q
107DRGCHK(PSODFN,DREN,DDRUG) ;Only check DREN against drug in DDRG()
108 ;* PSODFN = Patient's DFN
109 ;* DREN = Dispense drug to be checked against the drug in the array
110 ;* DDRUG = The array of dispense drug in the buffer.
111 ;*
112 K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
113 NEW DDRUG0,DDRUGND,COD,PSJINX S COD="",PSJINX=0
114 S DDRUG=0 F S DDRUG=$O(DDRUG(DDRUG)) Q:'DDRUG D DDRUG^PSJORUT2
115 D DRG
116 Q
117OIDRG(PSODFN,PSOI) ;checks every drug tied to orderable item passed by package use
118 K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC"),DD,DC,DI N DREN S INDX=0,PSOPHI=1
119 ;build patient's drug profile inpat/outpat/non-va
120 D BLD,ENCHK^PSJORUT2(PSODFN,.INDX),NVA
121 F DREN=0:0 S DREN=$O(^PSDRUG("ASP",PSOI,DREN)) Q:'DREN I $D(^PSDRUG(DREN,O)) D DRG
122 K PSOPHI D EXIT
123 Q
124NVA ;checks existing nva
125 F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",I)) Q:'I D:$D(^PS(55,PSODFN,"NVA",I,0))
126 .Q:$P(^PS(55,PSODFN,"NVA",I,0),"^",7)
127 .S PSOI=$P(^PS(55,PSODFN,"NVA",I,0),"^"),DRG=$P(^(0),"^",2),ORN=$P(^(0),"^",8)
128 .I DRG,$G(^PSDRUG(DRG,0))]"" D NVA1 K DRG Q
129 .K DRG F DRG=0:0 S DRG=$O(^PSDRUG("ASP",PSOI,DRG)) Q:'DRG D:$D(^PSDRUG(DRG,0)) NVA1
130 K I,PSOOTC,ORN,PSOI,DRG,DRGN,PSOY,VACL,NDF
131 Q
132NVA1 S PSOY=$G(^PSDRUG(DRG,0)),DRGN=$P(PSOY,"^"),VACL=$P(PSOY,"^",2)
133 S NDF=$S($G(^PSDRUG(DRG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
134 S INDX=$G(INDX)+1,^TMP($J,"ORDERS",INDX)=VACL_"^"_NDF_"^"_DRGN_"^"_ORN_"^"_I_"N;O"
135 Q
136 ;
137REMOTE ;
138 I $T(HAVEHDR^ORRDI1)']"" Q
139 I '$$HAVEHDR^ORRDI1 Q
140 D REMOTE^PSOORRDI(PSODFN,DREN)
141 K ^TMP($J,"DI"_PSODFN) ;THIS LEVEL ONLY NEEDED FOR BACKDOOR OUTPATIENT PHARMACY CHECKS
142 Q
143 ;
Note: See TracBrowser for help on using the repository browser.