source: FOIAVistA/tag/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBMLEN1.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1PSBMLEN1 ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;**3,4,9,11,13**;Mar 2004
3 ;
4 ; Reference/IA
5 ; ENE^PSJBCMA4/3416
6 ; ^XUSEC/10076
7 ; HLP^DDSUTL/10150
8 ;
9NEW(Y) ; Create the new entry
10 N PSBREC,PSB,PSBADST,PSBFREQ
11 S PSBMMEN=1
12 W @IOF D CLEAN^PSBVT,PSJ1^PSBVT(DFN,Y)
13 D NOW^%DTC
14 I PSBOSP<% D Q:%'=1
15 .W @IOF,$C(7)
16 .W !,"NOTICE: This order is NOT currently active."
17 .W !," Are You Sure You Want To Continue"
18 .S %=2 D YN^DICN
19 I PSBADST="" S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX),PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBDT)
20 E K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
21 S PSBODSCH=0 I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODSCH=1
22 W !,"Order: ",PSBONX
23 W !,"Medication: ",PSBOITX
24 W !,"Dosage: ",PSBDOSE
25 W !,"Schedule: ",PSBSCH
26 W !,"Admin Times: ",$S(PSBODSCH:"(Odd Sched.)",1:PSBADST)
27 I $D(^XUSEC("PSB READ ONLY",DUZ)) D Q
28 .W !!,"Medications CANNOT be administered while in PSB READ ONLY mode.",!! R "Press ENTER KEY to continue. ",PSBCNTNU:5
29 W !!,"Is this the correct Order" S %=1 D YN^DICN Q:%'=1
30 ;
31 ; PRN, One-Time, On Call orders
32 ;
33 I PSBSCHT'="C" D
34 .D VAL^PSBMLVAL(.PSB,DFN,+PSBONX,$E(PSBONX,$L(PSBONX)))
35 .I PSBSCHT="P",($D(PSB(1))) W !!,"Brief Administration History: ",! S X=$O(PSB(" "),-1),X=$S(X>4:4,1:X) F I=1:1:X W !,?5,PSB(I)
36 .I $D(^XUSEC("PSB READ ONLY",DUZ)) W !,"This operation is NOT AVAILABLE in PSB READ ONLY mode.",! Q
37 .I ($D(^XUSEC("PSB STUDENT",DUZ))),('$D(^XUSEC("PSB INSTRUCTOR"))) W !,"This operation is NOT AVAILABLE in PSB READ ONLY mode.",! Q
38 .W !!,"Create an administration for this order" S %=1 D YN^DICN Q:%'=1
39 .I PSBSCHT="P" D Q:Y=""!(Y["^")
40 ..K DIR S DIR(0)="FB^1:30",DIR("A")="PRN Reason (1-30 characters)"
41 ..W !!,"NOTICE: PRN Reason is Required for ALL PRN Entries",!
42 ..D ^DIR
43 ..I Y=""!(Y["^") W !!,"Sorry, Reason is required, No Entry Made!" Q
44 ..S PSBREC(6)=$P(Y,"|")
45 .; Build the form of dosage to CAP or TAB or null
46 .S:(PSBDOSEF'?1"CAP".E)&(PSBDOSEF'?1"TAB".E)&(PSBDOSEF'?1"PATCH".E) PSBDOSEF=""
47 .; Build the variable dose check #####-#####MG
48 .S PSBVARD=$S(PSBDOSE?1.5N1"-"1.5N.E:1,1:0)
49 .S PSBREC(0)=DFN
50 .S PSBREC(1)=PSBONX
51 .S PSBREC(2)=PSBSCHT
52 .S PSBREC(3)="G"
53 .S PSBREC(4)=PSBOIT
54 .S PSBREC(5)=""
55 .S PSBREC(7)="Entry created with 'Manual Medication Entry' option."
56 .S PSBREC(8)=""
57 .S PSBREC(9)=$S(PSBONX["U":"UDTAB",1:"PBTAB")
58 .S PSBINDX=10
59 .S X="" F S X=$O(PSBDDA(X)) Q:X="" S PSBREC(PSBINDX)=$P(PSBDDA(X),U,1,2)_U_$P(PSBDDA(X),U,4)_U_$P(PSBDDA(X),U,4)_U_PSBDOSEF,PSBINDX=PSBINDX+1
60 .S X="" F S X=$O(PSBADA(X)) Q:X="" S PSBREC(PSBINDX)=PSBADA(X),PSBINDX=PSBINDX+1
61 .S X="" F S X=$O(PSBSOLA(X)) Q:X="" S PSBREC(PSBINDX)=PSBSOLA(X),PSBINDX=PSBINDX+1
62 .D FILE
63 .I $G(DA),PSBREC(2)="O",$D(^PSB(53.79,DA)) I $P(^PSB(53.79,DA,0),U,9)="G" D ENE^PSJBCMA4(PSBREC(0),PSBREC(1))
64 ;
65 ; Continuous Meds
66 ;
67 I PSBSCHT="C" D
68 .W ! S %DT="AEQ",%DT("A")="Enter the DATE the medication was administered: "
69 .D NOW^%DTC S %DT(0)=(-1)*X,%DT("B")="" D ^%DT K %DT(0) Q:Y<1 S PSBDTX=Y D D^DIQ
70 .S:PSBODSCH PSBSCTMX=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBDTX)
71 .F PSBXX=0:1 Q:$G(^TMP("PSB",$J,"GETADMIN",PSBXX))="" D
72 ..S X="",Y=$G(^TMP("PSB",$J,"GETADMIN",PSBXX))
73 ..F Z=1:1:$L(Y,"-") S X=X_$S(X]"":";",1:"")_Z_":"_$P(Y,"-",Z)
74 .I PSBODSCH,PSBSCTMX="" D Q
75 ..W !!,"Order "_PSBONX_" is NOT SCHEDULED for administration on that entered date."
76 ..K DIR S DIR(0)="E^" D ^DIR
77 .K DIR S DIR(0)="S^"_X,DIR("A")="Select Administration Time"
78 .D ^DIR Q:Y<1
79 .S PSBDTX=+(PSBDTX_"."_Y(0))
80 .S Y=PSBDTX D D^DIQ
81 .W !!,"Create an administration for ",Y S %=1 D YN^DICN Q:%'=1
82FORUM .; Build the form of dosage to CAP or TAB or null
83 .S PSBDOSEF=PSBDOSEF
84 .S:(PSBDOSEF'?1"CAP".E)&(PSBDOSEF'?1"TAB".E)&(PSBDOSEF'?1"PATCH".E) PSBDOSEF=""
85 .; Build the variable dose check #####-#####MG
86 .S PSBVARD=$S(PSBDOSE?1.5N1"-"1.5N.E:1,1:0)
87 .S PSBREC(0)=DFN
88 .S PSBREC(1)=PSBONX
89 .S PSBREC(2)=PSBSCHT
90 .S PSBREC(3)="G"
91 .S PSBREC(4)=PSBOIT
92 .S PSBREC(5)=PSBDTX
93 .S PSBREC(6)=""
94 .S PSBREC(7)="Entry created with 'Manual Medication Entry' option."
95 .S PSBREC(8)=""
96 .S PSBREC(9)=$S(PSBONX["U":"UDTAB",1:"PBTAB")
97 .S PSBINDX=10
98 .S X="" F S X=$O(PSBDDA(X)) Q:X="" S PSBREC(PSBINDX)=$P(PSBDDA(X),U,1,2)_U_$P(PSBDDA(X),U,4)_U_$P(PSBDDA(X),U,4)_U_PSBDOSEF,PSBINDX=PSBINDX+1
99 .S X="" F S X=$O(PSBADA(X)) Q:X="" S PSBREC(PSBINDX)=PSBADA(X),PSBINDX=PSBINDX+1
100 .S X="" F S X=$O(PSBSOLA(X)) Q:X="" S PSBREC(PSBINDX)=PSBSOLA(X),PSBINDX=PSBINDX+1
101 .D FILE
102 Q
103 ;
104FILE ; Call the med log RPC to file it and DDS to edit it
105 N PSB,PSBSAVE,PSBAUDIT
106 D RPC^PSBML(.PSB,"+1^MEDPASS",.PSBREC)
107 I '$D(PSB) S PSB(0)=1,PSB(1)="-1^INCOMPLETE ENTRY^"_PSBINCX
108 I +PSB(1)<1 D Q
109 .W @IOF,!,"Error(s) Creating Med Log Entry",!
110 .S X=$S(PSB(0)=1:0,1:1) F S X=$O(PSB(X)) Q:X="" W !,$J($S(X=1:X,1:X-1),2),". ",$S(X=1:$P(PSB(X),"^",2),1:PSB(X))
111 .W !!,"No Med Log Entry Created.",!!
112 .K DIR S DIR(0)="E" D ^DIR
113 S PSBSAVE=0 S:'$G(PSBMMEN) PSBAUDIT=1
114 S DA=$P(PSB(1),U,3),DDSFILE=53.79,DDSPARM="C"
115 I $P(^PSB(53.79,DA,.1),U,1)?.N1"U" S DR="[PSB NEW UD ENTRY]"
116 I $P(^PSB(53.79,DA,.1),U,1)?.N1"V" S DR="[PSB NEW IV ENTRY]"
117 D ^DDS
118 L +^PSB(53.79,DA):1 I L -^PSB(53.79,DA) I PSBSAVE'=1 D
119 .W !,"Incomplete Med Log Entry, Deleting...#",DA S A=^PSB(53.79,DA,0),DFN=$P(A,U,1),AADT=$P(A,U,6)
120 .K ^PSB(53.79,"AADT",DFN,AADT,DA) S DIK="^PSB(53.79," D ^DIK
121 I PSBSAVE=1 D
122 .I $D(DA) D:($P(^PSB(53.79,DA,0),U,9)="G")
123 ..I $D(^PSB(53.79,DA,.5)) S PSBY=0 F S PSBY=$O(^PSB(53.79,DA,.5,PSBY)) Q:+PSBY<1 D
124 ...I $P(^PSB(53.79,DA,.5,PSBY,0),U,4)="PATCH" D
125 ....S (PSBYX,PSBXUIT)="" F S PSBYX=$O(^PSB(53.79,"AORDX",PSBDFN,PSBONX,PSBYX),-1) Q:PSBYX="" D Q:PSBXUIT
126 .....S PSBYZ="" S PSBYZ=$O(^PSB(53.79,"AORDX",PSBDFN,PSBONX,PSBYX,PSBYZ)) I (PSBYZ'=DA),$P(^PSB(53.79,PSBYZ,0),U,9)="G" D
127 ......W !!,"PATCH has been GIVEN before this admin completed; Deleting Med Log Entry...#",DA,!! S A=^PSB(53.79,DA,0),DFN=$P(A,U,1),AADT=$P(A,U,6)
128 ......K ^PSB(53.79,"AADT",DFN,AADT,DA) S DIK="^PSB(53.79," D ^DIK
129 ......S PSBXUIT=1
130 ....Q:PSBXUIT
131 ....S ^PSB(53.79,"APATCH",$P(^PSB(53.79,DA,0),U),$P(^PSB(53.79,DA,0),U,6),DA)=""
132 .Q:(PSBIEN="+1")&('$D(PSBIEN(1)))
133 .Q:$G(PSBXUIT)
134 .S X=$S($P(PSBIEN,",",2)]"":$P(PSBIEN,",",2),PSBIEN="+1":PSBIEN(1),1:"")
135 .I X]"" I ($F("HR",$P(^PSB(53.79,X,0),U,9))>1) F Y=.5,.6,.7 S Z=0 F S Z=$O(^PSB(53.79,X,Y,Z)) Q:+Z=0 S $P(^PSB(53.79,X,Y,Z,0),U,3)=0
136 Q
137 ;
138FDATE ;Check Admin Time for future date/time.
139 N PSBTIMX
140 S PSBTIMX=X D NOW^%DTC
141 I PSBTIMX>% W $C(7) S (DDSERROR,DDSBR)=1 D HLP^DDSUTL("Future date/time is not allowed")
142 Q
143 ;
Note: See TracBrowser for help on using the repository browser.