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
 ;