144 lines
6.4 KiB
Mathematica
144 lines
6.4 KiB
Mathematica
PSBMLEN1 ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;Mar 2004
|
|
;;3.0;BAR CODE MED ADMIN;**3,4,9,11,13**;Mar 2004
|
|
;
|
|
; Reference/IA
|
|
; ENE^PSJBCMA4/3416
|
|
; ^XUSEC/10076
|
|
; HLP^DDSUTL/10150
|
|
;
|
|
NEW(Y) ; Create the new entry
|
|
N PSBREC,PSB,PSBADST,PSBFREQ
|
|
S PSBMMEN=1
|
|
W @IOF D CLEAN^PSBVT,PSJ1^PSBVT(DFN,Y)
|
|
D NOW^%DTC
|
|
I PSBOSP<% D Q:%'=1
|
|
.W @IOF,$C(7)
|
|
.W !,"NOTICE: This order is NOT currently active."
|
|
.W !," Are You Sure You Want To Continue"
|
|
.S %=2 D YN^DICN
|
|
I PSBADST="" S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX),PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBDT)
|
|
E K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
|
|
S PSBODSCH=0 I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODSCH=1
|
|
W !,"Order: ",PSBONX
|
|
W !,"Medication: ",PSBOITX
|
|
W !,"Dosage: ",PSBDOSE
|
|
W !,"Schedule: ",PSBSCH
|
|
W !,"Admin Times: ",$S(PSBODSCH:"(Odd Sched.)",1:PSBADST)
|
|
I $D(^XUSEC("PSB READ ONLY",DUZ)) D Q
|
|
.W !!,"Medications CANNOT be administered while in PSB READ ONLY mode.",!! R "Press ENTER KEY to continue. ",PSBCNTNU:5
|
|
W !!,"Is this the correct Order" S %=1 D YN^DICN Q:%'=1
|
|
;
|
|
; PRN, One-Time, On Call orders
|
|
;
|
|
I PSBSCHT'="C" D
|
|
.D VAL^PSBMLVAL(.PSB,DFN,+PSBONX,$E(PSBONX,$L(PSBONX)))
|
|
.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)
|
|
.I $D(^XUSEC("PSB READ ONLY",DUZ)) W !,"This operation is NOT AVAILABLE in PSB READ ONLY mode.",! Q
|
|
.I ($D(^XUSEC("PSB STUDENT",DUZ))),('$D(^XUSEC("PSB INSTRUCTOR"))) W !,"This operation is NOT AVAILABLE in PSB READ ONLY mode.",! Q
|
|
.W !!,"Create an administration for this order" S %=1 D YN^DICN Q:%'=1
|
|
.I PSBSCHT="P" D Q:Y=""!(Y["^")
|
|
..K DIR S DIR(0)="FB^1:30",DIR("A")="PRN Reason (1-30 characters)"
|
|
..W !!,"NOTICE: PRN Reason is Required for ALL PRN Entries",!
|
|
..D ^DIR
|
|
..I Y=""!(Y["^") W !!,"Sorry, Reason is required, No Entry Made!" Q
|
|
..S PSBREC(6)=$P(Y,"|")
|
|
.; Build the form of dosage to CAP or TAB or null
|
|
.S:(PSBDOSEF'?1"CAP".E)&(PSBDOSEF'?1"TAB".E)&(PSBDOSEF'?1"PATCH".E) PSBDOSEF=""
|
|
.; Build the variable dose check #####-#####MG
|
|
.S PSBVARD=$S(PSBDOSE?1.5N1"-"1.5N.E:1,1:0)
|
|
.S PSBREC(0)=DFN
|
|
.S PSBREC(1)=PSBONX
|
|
.S PSBREC(2)=PSBSCHT
|
|
.S PSBREC(3)="G"
|
|
.S PSBREC(4)=PSBOIT
|
|
.S PSBREC(5)=""
|
|
.S PSBREC(7)="Entry created with 'Manual Medication Entry' option."
|
|
.S PSBREC(8)=""
|
|
.S PSBREC(9)=$S(PSBONX["U":"UDTAB",1:"PBTAB")
|
|
.S PSBINDX=10
|
|
.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
|
|
.S X="" F S X=$O(PSBADA(X)) Q:X="" S PSBREC(PSBINDX)=PSBADA(X),PSBINDX=PSBINDX+1
|
|
.S X="" F S X=$O(PSBSOLA(X)) Q:X="" S PSBREC(PSBINDX)=PSBSOLA(X),PSBINDX=PSBINDX+1
|
|
.D FILE
|
|
.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))
|
|
;
|
|
; Continuous Meds
|
|
;
|
|
I PSBSCHT="C" D
|
|
.W ! S %DT="AEQ",%DT("A")="Enter the DATE the medication was administered: "
|
|
.D NOW^%DTC S %DT(0)=(-1)*X,%DT("B")="" D ^%DT K %DT(0) Q:Y<1 S PSBDTX=Y D D^DIQ
|
|
.S:PSBODSCH PSBSCTMX=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBDTX)
|
|
.F PSBXX=0:1 Q:$G(^TMP("PSB",$J,"GETADMIN",PSBXX))="" D
|
|
..S X="",Y=$G(^TMP("PSB",$J,"GETADMIN",PSBXX))
|
|
..F Z=1:1:$L(Y,"-") S X=X_$S(X]"":";",1:"")_Z_":"_$P(Y,"-",Z)
|
|
.I PSBODSCH,PSBSCTMX="" D Q
|
|
..W !!,"Order "_PSBONX_" is NOT SCHEDULED for administration on that entered date."
|
|
..K DIR S DIR(0)="E^" D ^DIR
|
|
.K DIR S DIR(0)="S^"_X,DIR("A")="Select Administration Time"
|
|
.D ^DIR Q:Y<1
|
|
.S PSBDTX=+(PSBDTX_"."_Y(0))
|
|
.S Y=PSBDTX D D^DIQ
|
|
.W !!,"Create an administration for ",Y S %=1 D YN^DICN Q:%'=1
|
|
FORUM .; Build the form of dosage to CAP or TAB or null
|
|
.S PSBDOSEF=PSBDOSEF
|
|
.S:(PSBDOSEF'?1"CAP".E)&(PSBDOSEF'?1"TAB".E)&(PSBDOSEF'?1"PATCH".E) PSBDOSEF=""
|
|
.; Build the variable dose check #####-#####MG
|
|
.S PSBVARD=$S(PSBDOSE?1.5N1"-"1.5N.E:1,1:0)
|
|
.S PSBREC(0)=DFN
|
|
.S PSBREC(1)=PSBONX
|
|
.S PSBREC(2)=PSBSCHT
|
|
.S PSBREC(3)="G"
|
|
.S PSBREC(4)=PSBOIT
|
|
.S PSBREC(5)=PSBDTX
|
|
.S PSBREC(6)=""
|
|
.S PSBREC(7)="Entry created with 'Manual Medication Entry' option."
|
|
.S PSBREC(8)=""
|
|
.S PSBREC(9)=$S(PSBONX["U":"UDTAB",1:"PBTAB")
|
|
.S PSBINDX=10
|
|
.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
|
|
.S X="" F S X=$O(PSBADA(X)) Q:X="" S PSBREC(PSBINDX)=PSBADA(X),PSBINDX=PSBINDX+1
|
|
.S X="" F S X=$O(PSBSOLA(X)) Q:X="" S PSBREC(PSBINDX)=PSBSOLA(X),PSBINDX=PSBINDX+1
|
|
.D FILE
|
|
Q
|
|
;
|
|
FILE ; Call the med log RPC to file it and DDS to edit it
|
|
N PSB,PSBSAVE,PSBAUDIT
|
|
D RPC^PSBML(.PSB,"+1^MEDPASS",.PSBREC)
|
|
I '$D(PSB) S PSB(0)=1,PSB(1)="-1^INCOMPLETE ENTRY^"_PSBINCX
|
|
I +PSB(1)<1 D Q
|
|
.W @IOF,!,"Error(s) Creating Med Log Entry",!
|
|
.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))
|
|
.W !!,"No Med Log Entry Created.",!!
|
|
.K DIR S DIR(0)="E" D ^DIR
|
|
S PSBSAVE=0 S:'$G(PSBMMEN) PSBAUDIT=1
|
|
S DA=$P(PSB(1),U,3),DDSFILE=53.79,DDSPARM="C"
|
|
I $P(^PSB(53.79,DA,.1),U,1)?.N1"U" S DR="[PSB NEW UD ENTRY]"
|
|
I $P(^PSB(53.79,DA,.1),U,1)?.N1"V" S DR="[PSB NEW IV ENTRY]"
|
|
D ^DDS
|
|
L +^PSB(53.79,DA):1 I L -^PSB(53.79,DA) I PSBSAVE'=1 D
|
|
.W !,"Incomplete Med Log Entry, Deleting...#",DA S A=^PSB(53.79,DA,0),DFN=$P(A,U,1),AADT=$P(A,U,6)
|
|
.K ^PSB(53.79,"AADT",DFN,AADT,DA) S DIK="^PSB(53.79," D ^DIK
|
|
I PSBSAVE=1 D
|
|
.I $D(DA) D:($P(^PSB(53.79,DA,0),U,9)="G")
|
|
..I $D(^PSB(53.79,DA,.5)) S PSBY=0 F S PSBY=$O(^PSB(53.79,DA,.5,PSBY)) Q:+PSBY<1 D
|
|
...I $P(^PSB(53.79,DA,.5,PSBY,0),U,4)="PATCH" D
|
|
....S (PSBYX,PSBXUIT)="" F S PSBYX=$O(^PSB(53.79,"AORDX",PSBDFN,PSBONX,PSBYX),-1) Q:PSBYX="" D Q:PSBXUIT
|
|
.....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
|
|
......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)
|
|
......K ^PSB(53.79,"AADT",DFN,AADT,DA) S DIK="^PSB(53.79," D ^DIK
|
|
......S PSBXUIT=1
|
|
....Q:PSBXUIT
|
|
....S ^PSB(53.79,"APATCH",$P(^PSB(53.79,DA,0),U),$P(^PSB(53.79,DA,0),U,6),DA)=""
|
|
.Q:(PSBIEN="+1")&('$D(PSBIEN(1)))
|
|
.Q:$G(PSBXUIT)
|
|
.S X=$S($P(PSBIEN,",",2)]"":$P(PSBIEN,",",2),PSBIEN="+1":PSBIEN(1),1:"")
|
|
.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
|
|
Q
|
|
;
|
|
FDATE ;Check Admin Time for future date/time.
|
|
N PSBTIMX
|
|
S PSBTIMX=X D NOW^%DTC
|
|
I PSBTIMX>% W $C(7) S (DDSERROR,DDSBR)=1 D HLP^DDSUTL("Future date/time is not allowed")
|
|
Q
|
|
;
|