source: FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUT2.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 7.0 KB
Line 
1PSJLMUT2 ;BIR/JLC-DISPLAY UTILITIES ;22 Jun 05
2 ;;5.0; INPATIENT MEDICATIONS ;**146,175**;16 DEC 97;Build 18
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191.
5 ; Reference to ^PSDRUG is supported by DBIA# 2192.
6 ; Reference to ^PSSLOCK is supported by DBIA# 2789.
7 ; Reference to ^VA(200 is supported by DBIA# 10060.
8 ;
9SHOR(PSJT,PSJI) ;Display outpatient remote order checks.
10 ;; PSJT = Type of order check in ^TMP
11 ;; PSJI = Index to ^TMP to find order check detail
12 ;
13 N PSJD0,PSJD1,PSJRX,PSJRS,FSIG,PSJULN,PSJLF,PSJDN
14 S PSJD0=^TMP($J,PSJT,PSJI,0),PSJD1=^(1)
15 I PSJT="DD" S PSJRX=$P($P(PSJD0,"^",4),";"),PSJRS=$P(PSJD0,"^",5),PSJDN=$P(PSJD0,"^",2)
16 I PSJT="DC" S PSJRX=$P($P(PSJD0,"^",6),";"),PSJRS=$P(PSJD0,"^",7),PSJDN=$P(PSJD0,"^",4)
17 I PSJT="DI" S PSJRX=$P($P(PSJD0,"^",8),";"),PSJRS=$P(PSJD0,"^",9),PSJDN=$P(PSJD0,"^",2)
18 S PSJLF=$P(PSJD1,"^",3),$P(PSJULN,"-",79)=""
19 W !,PSJULN,!
20 W PSJRS I $L(PSJRS)>13 W !
21 W ?14,"Rx #: ",$E(PSJRX,1,$L(PSJRX)-1) I $A($L(PSJRX))<54 W $E(PSJRX,$L(PSJRX))
22 W ?39,PSJDN,! I PSJT="DI" W ?39,$P(PSJD0,"^",4)," INTERACTION",!
23 W $J("Status: ",20),$P(PSJD1,"^",2),?40,$J("Issued: ",20),$P(PSJD1,"^",9)
24 D FSIG(.FSIG)
25 W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),!
26 W $J("QTY: ",20)_$P(PSJD1,"^",5)
27 W !,$J("Provider: ",20),$P(PSJD1,"^",8),?40,$J("Refills remaining: ",20),$P(PSJD1,"^",6)
28 W !?40,$J("Last filled on: ",20),PSJLF
29 W !?40,$J("Days Supply: ",20)_$P(PSJD1,"^",4)
30 W !,PSJULN
31 Q
32 ;
33FSIG(FSIG) ;Format sig from remote site
34 ;returned in the FSIG array
35 N FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I
36 F I=0:1 Q:'$D(^TMP($J,PSJT,PSJI,1,I)) S HSIG(I+1)=^(I)
37FSTART S (FVAR,FVAR1)="",II=1
38 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
39 .S FVAR1=$P(HSIG(FFF)," ",(CNT))
40 .S FLIM=FVAR
41 .S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
42 I $G(FVAR)'="" S FSIG(II)=FVAR
43 I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2)
44FQUIT Q
45 ;
46DUPDRG(DFN) ;DEM - Duplicate Drug Check Ehancement
47 ;
48 ; Note: Display of Drug Interaction, Non-VA Meds, and Outpatient
49 ; orders is done by ORDCHK^PSJLMUT1. ORDCHK is called by
50 ; routine ENDDC^PSGSICHK before routine ENDDC^PSGSICHK calls
51 ; DUPDRG^PSJLMUT2. If ORDCHK finds "DD", or "DC" orders,
52 ; then ORDCHK will set "DD", or "DC" orders into
53 ; ^TMP($J,"DUPDRG",TYPE) global.
54 ;
55 K PSJDDCON ;Order continuation flag used by routine PSGSICHK.
56 S:$D(^TMP($J,"DI")) PSJDDCON("DI")=1 ;Order continuation flag used by routine PSGSICHK.
57 ; Quit if no duplicate drug orders(s), or duplicate drug class
58 ; order(s) found.
59 Q:'$D(^TMP($J,"DUPDRG","DD"))&'$D(^TMP($J,"DUPDRG","DC"))
60 S PSJDDCON("DD")=0 ;Order continuation flag used by routine PSGSICHK.
61 ;
62 ; Display orders in ^TMP($J,"DUPDRG",DUPLICATE_TYPE,ON,LINE_#)
63 ; (DUPLICATE TYPEs: "DD" - "Duplicate Drug"
64 ; "DC" - "Duplicate Drug Class"
65 ;
66 S PSJPDRG=1 ;If we are here, then set PSJPDRG=1. ORDCHK^PSJLMUT1 addresses this variable for Outpatient orders and "DI" orders.
67 N X,Y,DIR,TYPE,ON,PSJOC,PSJOCPOP,PSJSYSL
68 W !!,"This patient is already receiving the following INPATIENT order(s) for the same drug or in the same drug class as "_$S($G(PSJDD)]"":$P($G(^PSDRUG(PSJDD,0)),U),1:"the drug selected"),":",!!
69 D DSPLDD ;Display patients orders for the same drug or same drug class as drug selected.
70 ; Ask user if they wish to continue in spite of an order check.
71 S DIR(0)="Y",DIR("A")="Do you wish to continue with the current order",DIR("?",1)="Enter ""N"" if you wish to exit without creating a new order,"
72 S DIR("?")="or ""Y"" to continue with the order entry process.",DIR("B")="YES" D ^DIR I 'Y S PSGORQF=1,COMQUIT=1 K X,Y,DIR W ! Q
73 K X,Y,DIR
74 S PSJDDCON("DD")=1,PSJSYSL=0 ;Order continuation flag used by routine PSGSICHK.
75 W !
76 F D Q:('PSJOC)!(PSJOCPOP) ;Order discontinuation loop.
77 . N TYPE,ON,PSJOCSEQ
78 . S PSJOCPOP=0
79 . ; Ask user if they wish to discontinue any of the listed orders.
80 . S DIR(0)="Y",DIR("A")="Do you wish to DISCONTINUE any of the listed orders",DIR("?",1)="Enter ""N"" if you wish to exit without discontinuing any of the listed orders,"
81 . S DIR("?")="or ""Y"" to discontinue any of the listed orders.",DIR("B")="NO" D ^DIR I 'Y K X,Y,DIR S PSJOCPOP=1 W ! Q
82 . K X,Y,DIR
83 . W !
84 . ; Choose for DISCONTINUE 1-PSJOC (PSJOC is the total number of duplicate and duplicate class orders).
85 . S DIR(0)="N^1:"_PSJOC,DIR("A")="Choose for DISCONTINUE",DIR("?")="Choose an order 1-"_PSJOC D ^DIR I 'Y K X,Y,DIR S PSJOCPOP=1 W ! Q
86 . S PSJOCSEQ=+Y
87 . K X,Y,DIR
88 . ;
89 . ; *** Discontinue order ***
90 . S ON=$P(PSJOC(PSJOCSEQ),"^",2)
91 . I '$$LS^PSSLOCK(DFN,ON) S PSJOCPOP=1 Q
92 . S PSGSTAT=$$GTSTATUS^PSJOE(DFN,ON)
93 . D ;Set PSGOEEWF for order being discontinued - DRF
94 .. I ON["P" S PSGOEEWF="^PS(53.1,"_+ON_"," Q
95 .. I ON["U" S PSGOEEWF="^PS(55,"_DFN_",5,"_+ON_"," Q
96 .. S PSGOEEWF="^PS(55,"_DFN_",""IV"","_+ON_","
97 . D ;The following variables must be newed or they are stomped on by the discontinue code
98 .. N %DT,CF,D,D0,DA,DI,DIC,DIE,DISYS,DQ,DR,DRG,DRGT,DRGTMP,DRGX
99 .. N DTIME,FIL,I,JJ,LOC,OCXDT,OCXI,OCXSEG,ORIFN,ORO,POP,PSGALR
100 .. N PSGDT,PSGOEAV,PSJNOO,PSGOEDMR,PSGOEPR,PSGPDRG,PSGTOO,PSGTOL
101 .. N PSGUOW,PSIVOI,PSIVX,PSJCOM,PSJDD,PSJHLMTN,PSJMSG,PSJQO,PSOC
102 .. N Q,QQ,T,VA,VADM,VAERR,VAIN,XPARSYS,XQXFLG,Y,PSJRQPND
103 .. D
104 ... S PSJRQPND=1
105 ... I ON["V" D Q ;IV order
106 .... N PSJORD
107 .... S PSJORD=ON
108 .... D DC^PSJLIACT
109 ... D DC^PSJOE(DFN,ON) ;UD order
110 .. I $$GTSTATUS^PSJOE(DFN,ON)="D" D ; Clean up PSJOC and ^TMP($J,"DUPDRG") arrays, and reset PSJOC counter IF and after selected order has been discontinued.
111 ... S TYPE=$P(PSJOC(PSJOCSEQ),"^",1),ON=$P(PSJOC(PSJOCSEQ),"^",2),PSJOC=PSJOC-1
112 ... K PSJOC(PSJOCSEQ),^TMP($J,"DUPDRG",TYPE,ON),PSJOCSEQ
113 . D UNL^PSSLOCK(DFN,ON)
114 . Q:'PSJOC
115 . W !!,"Now, this patient is already receiving the following INPATIENT order(s) for the same drug or in the same drug class as "_$S($G(PSJDD)]"":$P($G(^PSDRUG(PSJDD,0)),U),1:"the drug selected"),":",!!
116 . D DSPLDD
117 . Q
118 W !
119 K PSJOCPOP,PSGSTAT
120 Q
121 ;
122DSPLDD ;
123 ; Display patients orders for the same drug or same drug class as drug selected.
124 N X,REQPROV,PSJLINE,PSJFLN
125 K PSJOC
126 ; Requesting Provider
127 S PSJOC=0
128 F TYPE="DD","DC" S ON="" F S ON=$O(^TMP($J,"DUPDRG",TYPE,ON)) Q:ON="" S PSJFLN=1 D
129 . I ON["U" S REQPROV=$P(^PS(55,DFN,5,+ON,0),"^",2)
130 . I ON["V" S REQPROV=$P(^PS(55,DFN,"IV",+ON,0),"^",6)
131 . I ON["P" S REQPROV=$P(^PS(53.1,+ON,0),"^",2)
132 . S REQPROV=$S(REQPROV>0:$P($G(^VA(200,REQPROV,0)),"^",1),1:"") S:REQPROV="" REQPROV="Requesting Provider Unknown"
133 . F PSJLINE=0:0 S PSJLINE=$O(^TMP($J,"DUPDRG",TYPE,ON,PSJLINE)) Q:'PSJLINE D
134 .. I PSJFLN=1 S PSJOC=PSJOC+1,PSJOC(PSJOC)=TYPE_"^"_ON W PSJOC_".",^TMP($J,"DUPDRG",TYPE,ON,PSJLINE),! S PSJFLN=PSJFLN+1 Q
135 .. S X=^TMP($J,"DUPDRG",TYPE,ON,PSJLINE) S:PSJFLN=2 X=$$SETSTR^VALM1(REQPROV,X,(48+$L(PSJOC_".")),25) W ?($L(PSJOC_".")),X,! S PSJFLN=PSJFLN+1 Q
136 .. Q
137 . Q
138 Q
139 ;
140PAUSE ;
141 K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W !
142 Q
Note: See TracBrowser for help on using the repository browser.