source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORRD2.m@ 1650

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1PSOORRD2 ;BHAM-ISC/EJW - Remote Data Interoperabilty Order Checks - backdoor ;06/26/05
2 ;;7.0;OUTPATIENT PHARMACY;**207**;DEC 1997
3 ;
4DUP ;Remote order - duplicate drug
5 N PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSORDI
6 S $P(PSOULN,"-",79)="",PSOT="DD"
7 S PSORDI=0 F S PSORDI=$O(^TMP($J,"DD",PSORDI)) Q:'PSORDI S PSOD0=^TMP($J,"DD",PSORDI,0),PSOD1=^(1),PSOREMX=$P($P(PSOD0,"^",4),";"),RDIINST=$P(PSOD0,"^",5),PSOLF=$P(PSOD1,"^",3) D
8 .W !,PSOULN,!
9 .W "Duplicate Drug ",$P(PSOD1,"^")," in Remote Prescription",!
10 .W ">> ",RDIINST,!
11 .W $J("Rx #: ",20)_$E(PSOREMX,1,$L(PSOREMX)-1),!
12 .W $J("Status: ",20),$P(PSOD1,"^",2)
13 .W ?44,$J("Issued: ",20),$P(PSOD1,"^",9)
14 .D FSIG(.FSIG)
15 .W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),!
16 .W $J("QTY: ",20),$P(PSOD1,"^",5),!
17 .W $J("Provider: ",20),$P(PSOD1,"^",8)
18 .W ?44,$J("Refills remaining: ",20),$P(PSOD1,"^",6)
19 .W !?44,$J("Last filled on: ",20),PSOLF
20 .W !?44,$J("Days Supply: ",20),$P(PSOD1,"^",4)
21 .D PAUSE
22 K PSOT
23 Q
24 ;
25CLS ;Remote order - duplicate drug class
26 N PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSORDI
27 S $P(PSOULN,"-",79)="",PSOT="DC"
28 S PSORDI=0 F S PSORDI=$O(^TMP($J,"DC",PSORDI)) Q:'PSORDI S PSOD0=^TMP($J,"DC",PSORDI,0),PSOD1=^(1),PSOREMX=$P($P(PSOD0,"^",6),";"),RDIINST=$P(PSOD0,"^",7),PSOLF=$P(PSOD1,"^",3) D
29 .W !,PSOULN,!
30 .W " *** SAME CLASS *** OF DRUG IN REMOTE RX FOR ",$P(PSOD1,"^"),!
31 .W ">> ",RDIINST,!
32 .W "CLASS: ",$P(PSOD0,"^"),!
33 .W $J("Rx #: ",20)_$E(PSOREMX,1,$L(PSOREMX)-1),!
34 .W $J("Status: ",20),$P(PSOD1,"^",2)
35 .W ?44,$J("Issued: ",20),$P(PSOD1,"^",9)
36 .D FSIG(.FSIG)
37 .W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),!
38 .W $J("QTY: ",20),$P(PSOD1,"^",5),!
39 .W $J("Provider: ",20),$P(PSOD1,"^",8)
40 .W ?44,$J("Refills remaining: ",20),$P(PSOD1,"^",6)
41 .W !?44,$J("Last filled on: ",20),PSOLF
42 .W !?44,$J("Days Supply: ",20),$P(PSOD1,"^",4)
43 .D PAUSE
44 K PSOT
45 Q
46FSIG(FSIG) ;Format sig from remote site
47 ;returned in the FSIG array
48 N FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I
49 F I=0:1 Q:'$D(^TMP($J,PSOT,PSORDI,1,I)) S HSIG(I+1)=^(I)
50FSTART S (FVAR,FVAR1)="",II=1
51 F FFF=0:0 S FFF=$O(HSIG(FFF)) Q:'FFF S CNT=0 F NNN=1:1:$L(HSIG(FFF)) I $E(HSIG(FFF),NNN)=" "!($L(HSIG(FFF))=NNN) S CNT=CNT+1 D I $L(FVAR)>52 S FSIG(II)=FLIM_" ",II=II+1,FVAR=FVAR1
52 .S FVAR1=$P(HSIG(FFF)," ",(CNT))
53 .S FLIM=FVAR
54 .S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
55 I $G(FVAR)'="" S FSIG(II)=FVAR
56 I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2)
57FQUIT Q
58SIGNIF ;
59 S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR
60 I Y I '$D(PSORX("INTERVENE")) S PSORX("INTERVENE")=2
61 I '$G(Y) K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q
62 Q
63 ;
64PAUSE ;
65 K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W ! K DIR
66 Q
67DRGINT ;DRUG-DRUG INTERACTION WITH ORDER FROM REMOTE SITE
68 N PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSOINT,PSORDI
69 S $P(PSOULN,"-",79)="",PSOT="DI"
70 S PSORDI=0 F S PSORDI=$O(^TMP($J,"DI",PSORDI)) Q:'PSORDI Q:$G(PSORX("DFLG")) S PSOD0=^TMP($J,"DI",PSORDI,0),PSOD1=^(1),PSOREMX=$P($P(PSOD0,"^",8),";"),RDIINST=$P(PSOD0,"^",9),PSOLF=$P(PSOD1,"^",3) D
71 .S PSOINT=$P(PSOD0,"^",4)
72 .W !,PSOULN,!
73 .W ">> ",RDIINST,!
74 .W ?5,"** ",PSOINT," ** DRUG-DRUG interaction ",$P(PSOD0,"^",5)," & ",$P(PSOD0,"^",6),!
75 .W ?5,"Remote RX # ",$E(PSOREMX,1,$L(PSOREMX)-1)," Drug: ",$P(PSOD1,"^"),!
76 .W $J("Status: ",20),$P(PSOD1,"^",2)
77 .W ?44,$J("Issued: ",20),$P(PSOD1,"^",9)
78 .D FSIG(.FSIG)
79 .W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),!
80 .W $J("QTY: ",20),$P(PSOD1,"^",5),!
81 .W $J("Provider: ",20),$P(PSOD1,"^",8)
82 .W !?44,$J("Refills remaining: ",20),$P(PSOD1,"^",6)
83 .W !?44,$J("Last filled on: ",20),PSOLF
84 .W !?44,$J("Days Supply: ",20),$P(PSOD1,"^",4)
85 .I '$D(^XUSEC("PSORPH",DUZ)) Q ; CLERK/TECH ENTRY
86 .I PSOINT'="CRITICAL" D SIGNIF
87 .I PSOINT="CRITICAL" D CRI
88 K PSOT,PSORDI
89 Q
90 ;
91CRI ;process new drug interactions entered by pharmacist
92 K DIR S DIR("A",1)="",DIR("A",2)="Do you want to Process medication",DIR("A")=PSODRUG("NAME")_": ",DIR(0)="SA^1:PROCESS;0:ABORT ORDER ENTRY",DIR("B")="P"
93 S DIR("?",1)="Enter '1' or 'P' to Activate medication",DIR("?")=" '0' or 'A' to Abort Order Entry process" D ^DIR K X1,DIR I 'Y S PSORX("DFLG")=1,DGI="" K DTOUT,DIRUT,DIROUT,DUOUT,PSORX("INTERVENE") Q
94 D SIG^XUSESIG I X1="" K PSORX("INTERVENE") S PSORX("DFLG")=1 Q
95 S PSORX("INTERVENE")=1
96 K DUOUT,DTOUT,DIRUT,DIROUT
97 Q
Note: See TracBrowser for help on using the repository browser.