source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBMLEN.m@ 1800

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

initial load of WorldVistAEHR
File size: 8.1 KB
Line 
1PSBMLEN ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;**4,9,19**;Mar 2004
3 ;
4 ; Reference/IA
5 ; EN^PSJBCMA/2828
6 ; ENE^PSJBCMA4/3416
7 ; ENR^PSJBCMA4/3416
8 ; ^XUSEC/10076
9 ; ^DPT/10035
10 ; $$GET^XPAR/2263
11 ; HLP^DDSUTL/10150
12 ;
13EN ;
14 N PSBCNT,PSBDT,PSBERR,PSBFORM,PSBMED,PSBNOW,PSBSCHT,PSBVARD,PSBX,PSBFREQ,PSBFLAG
15 K ^TMP("PSB",$J),^TMP("PSJ",$J),PSBREC
16 W @IOF,!,"Manual Medication Entry",!
17 I $D(^XUSEC("PSB READ ONLY",DUZ)) W !,"This option is NOT AVAILABLE in PSB READ ONLY mode.",! Q
18 W !,"Notice: No validation of medications is done with this option."
19 W !,"Entries in the Med Log created with this option will reflect this"
20 W !,"in the comments.",!!
21 S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: "
22 D ^DIC K DIC Q:+Y<1
23 S DFN=+Y
24 D EN1
25 K ^TMP("PSBO",$J)
26 Q
27 ;
28EN1 ;
29 S %DT="AEQ",%DT("B")="Today",%DT("A")="Select Orders From Date: "
30 D ^%DT Q:+Y<1 S PSBDT=+Y
31 W !,"Searching for Orders..."
32 K ^TMP("PSJ",$J)
33 D EN^PSJBCMA(DFN,PSBDT,"")
34 Q:$G(^TMP("PSJ",$J,1,0))=-1
35 S PSBERR=0
36 D NOW^%DTC S PSBNOW=%
37 F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
38 .D CLEAN^PSBVT,PSJ^PSBVT(PSBX)
39 .Q:PSBONX?.N1"P" ; No Pending Yet
40 .I "PCS"'[PSBIVT,PSBONX'["U" Q
41 .I PSBIVT["S",PSBISYR'=1 Q ; allow intermittent syringe only
42 .I PSBIVT["C",PSBCHEMT'="P",PSBISYR'=1 Q
43 .I PSBIVT["C",PSBCHEMT="A" Q ; allow Chemo with intermittent syringe or Piggyback type only
44 .K ^TMP("PSBO",$J)
45 .S PSBOUT=0
46 .D:PSBSCHT="C"
47 ..;Calculate admin times based on Frequency from IPM
48 ..S (PSBYES,PSBODD)=0
49 ..S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
50 ..I PSBYES,PSBADST="" S PSBOUT=1 Q
51 ..I PSBSCH?2.4N.E S PSBYES=1
52 ..S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
53 ..I PSBFREQ="O" S PSBYES=1
54 ..I 'PSBYES,PSBADST="",PSBFREQ<1 S PSBOUT=1 Q
55 ..I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
56 ..I PSBODD,PSBADST'="" S PSBOUT=1 Q
57 ..I PSBADST="" S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBDT)
58 ..E K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
59 ..F PSBY=1:1 Q:$P(PSBADST,"-",PSBY)="" I ($P(PSBADST,"-",PSBY)'?2N)&($P(PSBADST,"-",PSBY)'?4N) S PSBOUT=1 Q ; Validate time(s)
60 .Q:PSBOUT
61 .Q:PSBOST>PSBNOW ; Future Start Date
62 .I PSBSCHT="O" S (PSBGVN,X,Y)="" D I (PSBGVN)!(PSBNGF) K PSBGVN,X,Y Q
63 ..F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
64 ...F S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y S:($P(^PSB(53.79,Y,.1),U)=PSBONX)&($P(^PSB(53.79,Y,0),U,9)'="N") PSBGVN=1,(X,Y)=0
65 .I PSBSCHT="OC" S (PSBGVN,X,Y)="" D I PSBGVN K PSBGVN,X,Y Q
66 ..F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
67 ...F S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y S:($P(^PSB(53.79,Y,.1),U)=PSBONX)&($P(^PSB(53.79,Y,0),U,9)'="N") PSBGVN=1,(X,Y)=0
68 ..S PSBGVN=PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL")) Q:PSBGVN
69 ..I PSBOSTS'="A"&(PSBOSTS'="R") S PSBGVN=1 Q
70 ..I PSBNGF S PSBGVN=1 Q
71 .S ^TMP("PSB",$J,PSBSCHT,PSBOITX,PSBX)=PSBONX_U_PSBADST_U_PSBOST_U_PSBOSP_U_PSBOSTS
72 I PSBERR W ! K DIR S DIR(0)="E" D ^DIR Q:Y="^"
73 ;
74EN2 ;
75 W $$HDR() I '$D(^TMP("PSB",$J)) W !!?5,"No Med Orders Found!",! Q
76 S PSBSCHT="",PSBCNT=0
77 F S PSBSCHT=$O(^TMP("PSB",$J,PSBSCHT)) Q:PSBSCHT="" D
78 .W ! ; Line between order types
79 .S PSBMED=""
80 .F S PSBMED=$O(^TMP("PSB",$J,PSBSCHT,PSBMED)) Q:PSBMED="" D
81 ..F PSBX=0:0 S PSBX=$O(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX)) Q:'PSBX D
82 ...I $Y>(IOSL-6) W ! K DIR S DIR(0)="E" D ^DIR W:Y $$HDR() I 'Y S PSBSCHT="Z" Q
83 ...S PSBCNT=PSBCNT+1
84 ...W !,$J(PSBCNT,2),". ",PSBSCHT,?7,PSBMED
85 ...W ?40," (",$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,5),")"
86 ...S Y=$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,3)
87 ...W:$X>44 !
88 ...W ?45,"Start: ",$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))_" "
89 ...W $E($P(Y,".",2)_"0000",1,4)
90 ...S Y=$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,4)
91 ...W !?45," Stop: ",$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))_" "
92 ...W $E($P(Y,".",2)_"0000",1,4)
93 ...I $P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2)]"" W !?7,"Admin Times: ",$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2)
94 ...W !
95 ...S ^TMP("PSBO",$J,PSBCNT)=$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,1)
96 F Q:$Y>(IOSL-5) W !
97 K DIR S DIR(0)="NO^1:"_PSBCNT_":0" D ^DIR
98 I Y S Y=^TMP("PSBO",$J,Y) D NEW^PSBMLEN1(Y) G EN2
99 Q
100 ;
101 ;
102HDR() ;
103 W @IOF,"Manual Medication Entry",!," #",?4,"Sc",?7,"Medication",?41,"St"
104 W !,$TR($J("",IOM)," ","-")
105 Q ""
106 ;
107EDIT ; Edit Medication Log
108 N PSBAUDIT
109 S PSBAUDIT=1
110 W:'$D(^XUSEC("PSB MANAGER",DUZ)) !!?5,"Notice: You are restricted from editing any entries other than",!," those that you have created.",!
111 S DA=""
112 S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select Patient Name: "
113 D ^DIC K DIC Q:+Y<1
114 S DFN=+Y
115 D EDIT1
116 K PSBCNT,PSBDT,PSBIEN,PSBSRCH,PSBTMP,DA,DFN,DR,DDSFILE
117 G EDIT
118 ;
119EDIT1 ;
120 S %DT="AEQ",%DT("A")="Select Date to Begin Searching Back From: "
121 W !! S %DT("B")="TODAY" D ^%DT Q:+Y<1 S PSBDT=Y
122 F D Q:'PSBDT
123 .W @IOF,!,"Searching Date " S Y=PSBDT D D^DIQ W Y
124 .W !," # Medication",?45,"St",?50,"D/T Given",?75,"Int"
125 .W !,$TR($J("",IOM)," ","-")
126 .S PSBSRCH=PSBDT+.9,PSBCNT=0
127 .K PSBTMP
128 .F S PSBSRCH=$O(^PSB(53.79,"AEDT",DFN,PSBSRCH),-1) Q:'PSBSRCH!(PSBSRCH<PSBDT) D
129 ..S PSBIEN=""
130 ..F S PSBIEN=$O(^PSB(53.79,"AEDT",DFN,PSBSRCH,PSBIEN),-1) Q:'PSBIEN D:$P(^PSB(53.79,PSBIEN,0),U,7)=DUZ!($D(^XUSEC("PSB MANAGER",DUZ)))
131 ...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
132 ...S PSBCNT=PSBCNT+1,PSBTMP(PSBCNT)=PSBIEN
133 ...D:$Y>19
134 ....W ! S DIR(0)="E" D ^DIR
135 ....W @IOF,!,"Searching Date " S Y=PSBDT D D^DIQ W Y
136 ....W !," # Medication",?45,"St",?50,"D/T Given",?75,"Int"
137 ....W !,$TR($J("",IOM)," ","-")
138 ...W !,$J(PSBCNT,2),". "
139 ...W ?5,$$GET1^DIQ(53.79,PSBIEN_",",.08)
140 ...I $$GET1^DIQ(53.79,PSBIEN_",",.26) W ?5," ("_$$GET1^DIQ(53.79,PSBIEN_",",.26)_")"
141 ...W ?45,$P(^PSB(53.79,PSBIEN,0),U,9)
142 ...W ?50,$$GET1^DIQ(53.79,PSBIEN_",",.06)
143 ...W ?75,$$GET1^DIQ(53.79,PSBIEN_",","ACTION BY:INITIAL")
144 .I PSBCNT D Q:Y
145 ..W ! S DIR(0)="NO^1:"_PSBCNT_":0" D ^DIR
146 ..I Y S DA=PSBTMP(Y),PSBDT=""
147 .I 'PSBCNT W !!?5,"No Meds Found!"
148 .S X1=PSBDT,X2=-1 D C^%DTC S (PSBDT,Y)=X D D^DIQ
149 .W !!,"Continue With ",Y
150 .S %=1 D YN^DICN I %'=1 S PSBDT=0
151 I DA D
152 .S PSBCOMP="",PSBDFN=$$GET1^DIQ(53.79,DA_",",.01,"I"),PSBONX=$$GET1^DIQ(53.79,DA_",",.11),PSBSTUS=$$GET1^DIQ(53.79,DA_",",.09,"I")
153 .I PSBONX["V",PSBSTUS'="G" D Q:PSBCOMP=1
154 ..S PSBBAGN=$$GET1^DIQ(53.79,DA_",",.26) D INFUSING^PSBVDLU2 Q:PSBCOMP=0
155 ..I $D(PSBPORA(PSBONX)) S X="" F S X=$O(PSBPORA(PSBONX,X)),PSBBAG2=$P(PSBPORA(PSBONX,X),U,1),PSBBAGST=$P(PSBPORA(PSBONX,X),U,2) Q:PSBBAG2]""
156 ..I PSBBAGN=PSBBAG2 S PSBCOMP=0 Q
157 ..I (PSBBAGN'=PSBBAG2),PSBBAGST'="C" D
158 ...W !!,"Bag "_PSBBAG2_" is marked as ",$S(PSBBAGST="I":"Infusing",PSBBAGST="S":"Stopped",1:"unk")
159 ...W !,"This bag must be completed before bag "_PSBBAGN_" can be edited.",!!
160 ...K PSBORA,PSBBAGN,PSBBAG2,PSBBAGST
161 .I PSBONX["V" D PSJ1^PSBVT(PSBDFN,PSBONX)
162 .S DDSFILE=53.79 D
163 ..I PSBONX["U" S DR="[PSB MED LOG EDIT]" Q
164 ..I PSBIVT["P" S DR="[PSB MED LOG EDIT]" Q
165 ..I PSBIVT["S",PSBISYR=1 S DR="[PSB MED LOG EDIT]" Q
166 ..I PSBIVT["C",PSBISYR=1 S DR="[PSB MED LOG EDIT]" Q
167 ..I PSBIVT["C",PSBCHEMT="P" S DR="[PSB MED LOG EDIT]" Q
168 ..S DR="[PSB MED LOG EDIT IV]" Q
169 .D ^DDS
170 .;One time order reinstated if not given
171 .D:($P(^PSB(53.79,DA,.1),U,2)="O")&($P(^PSB(53.79,DA,0),U,9)="N") ENR^PSJBCMA4(DFN,$P(^PSB(53.79,DA,.1),U,1))
172 .D:($P(^PSB(53.79,DA,.1),U,2)="O")&($P(^PSB(53.79,DA,0),U,9)="G") ENE^PSJBCMA4(DFN,$P(^PSB(53.79,DA,.1),U,1))
173 Q
174 ;
175VALID ;
176 I $G(PSBSTUS)="RM","^RM^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Status of Removed cannot be changed.") Q
177 I $G(PSBREC(7))'="Entry created with 'Manual Medication Entry' option." D Q
178 .I ($D(^PSB(53.79,DA,.5,1,0))),($P($G(^PSB(53.79,DA,.5,1,0)),U,4)="PATCH") D Q
179 ..I "^G^N^H^R^RM^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Allowed status codes are Given, Not Given, Held, Refused and Removed.")
180 .I "^G^N^H^R^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Allowed status codes are Given, Not Given, Held, and Refused.")
181 I "^G^H^R^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Allowed status codes are Given, Held, and Refused.") Q
182 ;
183UNITS ;Check UNITS field for entry of PATCH
184 I Y'="PATCH" Q
185 S (DDSERROR,DDSBR)=1
186 S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
187 W $C(7)
188 D HLP^DDSUTL("Field cannot be changed to PATCH")
189 D REFRESH^DDSUTL
190 Q
191 ;
Note: See TracBrowser for help on using the repository browser.