PSBMLTS ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;Mar 2004
;;3.0;BAR CODE MED ADMIN;;Mar 2004
;
; Reference/IA
; EN^PSJBCMA/2828
; EN^PSJBCMA1/2829
; File 50/221
;
EN ;
N DFN,PSBCNT,PSBDT,PSBERR,PSBMED,PSBNOW,PSBSCHD,PSBVDT
K ^TMP("PSB",$J),^TMP("PSJ",$J),PSBORD,PSBREC
W @IOF,!,"Manual Medication Log Trouble Shooter",!!
S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: "
D ^DIC K DIC Q:+Y<1 S DFN=+Y
K DIR S DIR(0)="DO^",DIR("A")="Select Date To Validate"
D ^DIR Q:+Y<1
S PSBVDT=+Y
W !,"Searching for Orders..."
K ^TMP("PSJ",$J)
D EN^PSJBCMA(DFN,PSBVDT,"")
Q:$G(^TMP("PSJ",$J,1,0))=-1
S PSBERR=0
D NOW^%DTC S PSBNOW=%
F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
.Q:$P(^TMP("PSJ",$J,PSBX,0),U,3)?.N1"P" ; No Pending Yet
.K PSBORD,^TMP("PSBTMP",$J)
.M PSBORD=^TMP("PSJ",$J,PSBX)
.S PSBSCHD=$P(PSBORD(1),U,2)
.I PSBSCHD="" D Q
.I PSBSCHD="C"&($P(PSBORD(1),U,6)="") D Q
..W !!,"Notice: Order #",+$P(PSBORD(0),U,3)
..W $S($P(PSBORD(0),U,3)?.N1"U":" (UNIT DOSE) ",$P(PSBORD(0),U,3)?.N1"V":" (IV) ",1:"")
..W " doesn't have administration times"
.S ^TMP("PSB",$J,PSBSCHD,$P(PSBORD(3),U,2),PSBX)=$P(PSBORD(0),U,3)_U_$P(PSBORD(1),U,6)
D EN1 G EN
;
EN1 ;
W $$HDR() I '$D(^TMP("PSB",$J)) W !!?5,"No Med Orders Found!",! Q
S PSBSCHD="",PSBCNT=0
F S PSBSCHD=$O(^TMP("PSB",$J,PSBSCHD)) Q:PSBSCHD="" D
.W ! ; Line between order types
.S PSBMED=""
.F S PSBMED=$O(^TMP("PSB",$J,PSBSCHD,PSBMED)) Q:PSBMED="" D
..F PSBX=0:0 S PSBX=$O(^TMP("PSB",$J,PSBSCHD,PSBMED,PSBX)) Q:'PSBX D
...I $Y>(IOSL-6) W ! K DIR S DIR(0)="E" D ^DIR W:Y $$HDR() I 'Y S PSBSCHD="Z" Q
...S PSBCNT=PSBCNT+1
...W !,$J(PSBCNT,2),". ",PSBSCHD,?8,PSBMED
...W ?40,$P(^TMP("PSB",$J,PSBSCHD,PSBMED,PSBX),U,1),?50,$P(^(PSBX),U,2)
...S ^TMP("PSBTMP",$J,PSBCNT)=$P(^TMP("PSB",$J,PSBSCHD,PSBMED,PSBX),U,1)
F Q:$Y>(IOSL-5) W !
K DIR S DIR(0)="NO^1:"_PSBCNT_":0" D ^DIR
I Y S Y=^TMP("PSBTMP",$J,Y) D NEW(Y) K ^TMP("PSBTMP",$J) G EN1
Q
;
NEW(Y) ; Create the new entry
N PSBREC
K ^TMP("PSJ",$J),RESULTS
W @IOF D EN^PSJBCMA1(DFN,Y)
K PSBORD M PSBORD=^TMP("PSJ",$J)
W !,"Order: ",$P(PSBORD(0),U,3)
W !,"Medication: ",$P(PSBORD(2),U,2)
W !,"Dosage: ",$P(PSBORD(2),U,3)
W !,"Schedule: ",$P(PSBORD(4),U,2)
W !,"Admin Times: ",$P(PSBORD(4),U,9)
W !,"Start D/T: "
W !,"Stop D/T: "
W !!,"Is this the correct Order" S %=1 D YN^DICN Q:%'=1
;
; PRN, One-Time, On Call orders
;
I $P(PSBORD(4),U,1)'="C" D
.W ! S %DT="AEQR",%DT("A")="Enter the DATE/TIME of Administration: "
.S %DT("B")="Now" D ^%DT Q:Y<1 S PSBDT=Y D D^DIQ
.D FILE
;
; Continuous Meds
;
I $P(PSBORD(4),U,1)="C" D
.W ! S %DT="AEQ",%DT("A")="Enter the DATE of Administration: "
.S %DT("B")="Today" D ^%DT Q:Y<1 S PSBDT=Y D D^DIQ
.S X="",Y=$P(PSBORD(4),U,9)
.F Z=1:1:$L(Y,"-") D
..S X=X_$S(X]"":";",1:"")_Z_":"_$P(Y,"-",Z)
.K DIR S DIR(0)="S^"_X,DIR("A")="Select Administration Time"
.D ^DIR Q:Y<1
.S PSBDT=+(PSBDT_"."_Y(0))
.S Y=PSBDT D D^DIQ
.D FILE
Q
;
FILE ; Call the med log RPC to validate and order
I $D(^PSB(53.79,"AORD",DFN,$P(PSBORD(0),U,3),PSBDT)) W !,"-1^Medication is already logged!"
E D VAL^PSBMLVAL(.RESULTS,DFN,+$P(PSBORD(0),U,3),$E($P(PSBORD(0),U,3),$L($P(PSBORD(0),U,3))),PSBDT) S X="" F S X=$O(RESULTS(X)) Q:X="" W !,RESULTS(X)
K DIR S DIR(0)="E" D ^DIR
Q
;
HDR() ;
W @IOF,"Medication Log Trouble Shooter",!," # "
W !,$TR($J("",IOM)," ","-")
Q ""
;
SCANNER ; This checks the scanning mechanism
N PSBVAL,PSBSCAN,PSBX,PSBFLD
W ! K DIR
S DIR(0)="FO^1:45",DIR("A")="Scan Medication" D ^DIR Q:Y["^"!(Y="")
S PSBVAL=X K DIR
W !!,"Performing 'Exact Matches' scan of Drug File..."
K PSBSCAN D SMED(.PSBSCAN,X)
W !!,"Results of Scan:"
W $S(+PSBSCAN(0)>0:" Good",1:" Invalid")," scan value."
S X="" F S X=$O(PSBSCAN(X)) Q:X="" W !!?5,PSBSCAN(X)
G:+PSBSCAN(0)>0 SCANNER
W !!,"Performing 'Non-Exact Match' scan on the Drug File...",!
K ^TMP("DILIST",$J)
;
D FIND^DIC(50,"","","AX",PSBVAL,"*","B^C")
;
I +$G(^TMP("DILIST",$J,0))<1 W !!,"Nothing found in drug file matching '",PSBVAL,"'." G SCANNER
W !,"There are ",+^TMP("DILIST",$J,0)," matches to '",PSBVAL,"'."
F PSBX=0:0 S PSBX=$O(^TMP("DILIST",$J,2,PSBX)) Q:'PSBX D
.W !!,"MATCH #:..................",PSBX
.W !,"IEN:......................",^TMP("DILIST",$J,2,PSBX)
.W !,"NAME:.....................",^TMP("DILIST",$J,1,PSBX)
.S PSBFLD=0
.F S PSBFLD=$O(^TMP("DILIST",$J,"ID",PSBX,PSBFLD)) Q:'PSBFLD D
..D FIELD^DID(50,PSBFLD,"","LABEL","PSBFLD")
..W !,PSBFLD("LABEL"),":" F Q:$X>25 W "."
..W ^TMP("DILIST",$J,"ID",PSBX,PSBFLD)
K ^TMP("DILIST",$J)
Q
;
SMED(RESULTS,PSBDATA) ; Lookup Medication
I $$GET^XPAR("DIV","PSB ROBOT RX"),PSBDATA?1"3"15N!(PSBDATA?1"3"17N),123[$E(PSBDATA,12) S PSBDATA=$E(PSBDATA,2,11)
S X=$$FIND1^DIC(50,"","AX",PSBDATA,"B^C")
I X<1 S RESULTS(0)="-1^Invalid Medication Lookup"
E S RESULTS(0)=X_U_$$GET1^DIQ(50,X_",",.01)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBMLTS 5031 printed Apr 09, 2024@20:45:30 Page 2
PSBMLTS ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;Mar 2004
+1 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
+2 ;
+3 ; Reference/IA
+4 ; EN^PSJBCMA/2828
+5 ; EN^PSJBCMA1/2829
+6 ; File 50/221
+7 ;
EN ;
+1 NEW DFN,PSBCNT,PSBDT,PSBERR,PSBMED,PSBNOW,PSBSCHD,PSBVDT
+2 KILL ^TMP("PSB",$JOB),^TMP("PSJ",$JOB),PSBORD,PSBREC
+3 WRITE @IOF,!,"Manual Medication Log Trouble Shooter",!!
+4 SET DIC="^DPT("
SET DIC(0)="AEQM"
SET DIC("A")="Select PATIENT: "
+5 DO ^DIC
KILL DIC
if +Y<1
QUIT
SET DFN=+Y
+6 KILL DIR
SET DIR(0)="DO^"
SET DIR("A")="Select Date To Validate"
+7 DO ^DIR
if +Y<1
QUIT
+8 SET PSBVDT=+Y
+9 WRITE !,"Searching for Orders..."
+10 KILL ^TMP("PSJ",$JOB)
+11 DO EN^PSJBCMA(DFN,PSBVDT,"")
+12 if $GET(^TMP("PSJ",$JOB,1,0))=-1
QUIT
+13 SET PSBERR=0
+14 DO NOW^%DTC
SET PSBNOW=%
+15 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
if 'PSBX
QUIT
Begin DoDot:1
+16 ; No Pending Yet
if $PIECE(^TMP("PSJ",$JOB,PSBX,0),U,3)?.N1"P"
QUIT
+17 KILL PSBORD,^TMP("PSBTMP",$JOB)
+18 MERGE PSBORD=^TMP("PSJ",$JOB,PSBX)
+19 SET PSBSCHD=$PIECE(PSBORD(1),U,2)
+20 IF PSBSCHD=""
Begin DoDot:2
End DoDot:2
QUIT
+21 IF PSBSCHD="C"&($PIECE(PSBORD(1),U,6)="")
Begin DoDot:2
+22 WRITE !!,"Notice: Order #",+$PIECE(PSBORD(0),U,3)
+23 WRITE $SELECT($PIECE(PSBORD(0),U,3)?.N1"U":" (UNIT DOSE) ",$PIECE(PSBORD(0),U,3)?.N1"V":" (IV) ",1:"")
+24 WRITE " doesn't have administration times"
End DoDot:2
QUIT
+25 SET ^TMP("PSB",$JOB,PSBSCHD,$PIECE(PSBORD(3),U,2),PSBX)=$PIECE(PSBORD(0),U,3)_U_$PIECE(PSBORD(1),U,6)
End DoDot:1
+26 DO EN1
GOTO EN
+27 ;
EN1 ;
+1 WRITE $$HDR()
IF '$DATA(^TMP("PSB",$JOB))
WRITE !!?5,"No Med Orders Found!",!
QUIT
+2 SET PSBSCHD=""
SET PSBCNT=0
+3 FOR
SET PSBSCHD=$ORDER(^TMP("PSB",$JOB,PSBSCHD))
if PSBSCHD=""
QUIT
Begin DoDot:1
+4 ; Line between order types
WRITE !
+5 SET PSBMED=""
+6 FOR
SET PSBMED=$ORDER(^TMP("PSB",$JOB,PSBSCHD,PSBMED))
if PSBMED=""
QUIT
Begin DoDot:2
+7 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSB",$JOB,PSBSCHD,PSBMED,PSBX))
if 'PSBX
QUIT
Begin DoDot:3
+8 IF $Y>(IOSL-6)
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
if Y
WRITE $$HDR()
IF 'Y
SET PSBSCHD="Z"
QUIT
+9 SET PSBCNT=PSBCNT+1
+10 WRITE !,$JUSTIFY(PSBCNT,2),". ",PSBSCHD,?8,PSBMED
+11 WRITE ?40,$PIECE(^TMP("PSB",$JOB,PSBSCHD,PSBMED,PSBX),U,1),?50,$PIECE(^(PSBX),U,2)
+12 SET ^TMP("PSBTMP",$JOB,PSBCNT)=$PIECE(^TMP("PSB",$JOB,PSBSCHD,PSBMED,PSBX),U,1)
End DoDot:3
End DoDot:2
End DoDot:1
+13 FOR
if $Y>(IOSL-5)
QUIT
WRITE !
+14 KILL DIR
SET DIR(0)="NO^1:"_PSBCNT_":0"
DO ^DIR
+15 IF Y
SET Y=^TMP("PSBTMP",$JOB,Y)
DO NEW(Y)
KILL ^TMP("PSBTMP",$JOB)
GOTO EN1
+16 QUIT
+17 ;
NEW(Y) ; Create the new entry
+1 NEW PSBREC
+2 KILL ^TMP("PSJ",$JOB),RESULTS
+3 WRITE @IOF
DO EN^PSJBCMA1(DFN,Y)
+4 KILL PSBORD
MERGE PSBORD=^TMP("PSJ",$JOB)
+5 WRITE !,"Order: ",$PIECE(PSBORD(0),U,3)
+6 WRITE !,"Medication: ",$PIECE(PSBORD(2),U,2)
+7 WRITE !,"Dosage: ",$PIECE(PSBORD(2),U,3)
+8 WRITE !,"Schedule: ",$PIECE(PSBORD(4),U,2)
+9 WRITE !,"Admin Times: ",$PIECE(PSBORD(4),U,9)
+10 WRITE !,"Start D/T: "
+11 WRITE !,"Stop D/T: "
+12 WRITE !!,"Is this the correct Order"
SET %=1
DO YN^DICN
if %'=1
QUIT
+13 ;
+14 ; PRN, One-Time, On Call orders
+15 ;
+16 IF $PIECE(PSBORD(4),U,1)'="C"
Begin DoDot:1
+17 WRITE !
SET %DT="AEQR"
SET %DT("A")="Enter the DATE/TIME of Administration: "
+18 SET %DT("B")="Now"
DO ^%DT
if Y<1
QUIT
SET PSBDT=Y
DO D^DIQ
+19 DO FILE
End DoDot:1
+20 ;
+21 ; Continuous Meds
+22 ;
+23 IF $PIECE(PSBORD(4),U,1)="C"
Begin DoDot:1
+24 WRITE !
SET %DT="AEQ"
SET %DT("A")="Enter the DATE of Administration: "
+25 SET %DT("B")="Today"
DO ^%DT
if Y<1
QUIT
SET PSBDT=Y
DO D^DIQ
+26 SET X=""
SET Y=$PIECE(PSBORD(4),U,9)
+27 FOR Z=1:1:$LENGTH(Y,"-")
Begin DoDot:2
+28 SET X=X_$SELECT(X]"":";",1:"")_Z_":"_$PIECE(Y,"-",Z)
End DoDot:2
+29 KILL DIR
SET DIR(0)="S^"_X
SET DIR("A")="Select Administration Time"
+30 DO ^DIR
if Y<1
QUIT
+31 SET PSBDT=+(PSBDT_"."_Y(0))
+32 SET Y=PSBDT
DO D^DIQ
+33 DO FILE
End DoDot:1
+34 QUIT
+35 ;
FILE ; Call the med log RPC to validate and order
+1 IF $DATA(^PSB(53.79,"AORD",DFN,$PIECE(PSBORD(0),U,3),PSBDT))
WRITE !,"-1^Medication is already logged!"
+2 IF '$TEST
DO VAL^PSBMLVAL(.RESULTS,DFN,+$PIECE(PSBORD(0),U,3),$EXTRACT($PIECE(PSBORD(0),U,3),$LENGTH($PIECE(PSBORD(0),U,3))),PSBDT)
SET X=""
FOR
SET X=$ORDER(RESULTS(X))
if X=""
QUIT
WRITE !,RESULTS(X)
+3 KILL DIR
SET DIR(0)="E"
DO ^DIR
+4 QUIT
+5 ;
HDR() ;
+1 WRITE @IOF,"Medication Log Trouble Shooter",!," # "
+2 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+3 QUIT ""
+4 ;
SCANNER ; This checks the scanning mechanism
+1 NEW PSBVAL,PSBSCAN,PSBX,PSBFLD
+2 WRITE !
KILL DIR
+3 SET DIR(0)="FO^1:45"
SET DIR("A")="Scan Medication"
DO ^DIR
if Y["^"!(Y="")
QUIT
+4 SET PSBVAL=X
KILL DIR
+5 WRITE !!,"Performing 'Exact Matches' scan of Drug File..."
+6 KILL PSBSCAN
DO SMED(.PSBSCAN,X)
+7 WRITE !!,"Results of Scan:"
+8 WRITE $SELECT(+PSBSCAN(0)>0:" Good",1:" Invalid")," scan value."
+9 SET X=""
FOR
SET X=$ORDER(PSBSCAN(X))
if X=""
QUIT
WRITE !!?5,PSBSCAN(X)
+10 if +PSBSCAN(0)>0
GOTO SCANNER
+11 WRITE !!,"Performing 'Non-Exact Match' scan on the Drug File...",!
+12 KILL ^TMP("DILIST",$JOB)
+13 ;
+14 DO FIND^DIC(50,"","","AX",PSBVAL,"*","B^C")
+15 ;
+16 IF +$GET(^TMP("DILIST",$JOB,0))<1
WRITE !!,"Nothing found in drug file matching '",PSBVAL,"'."
GOTO SCANNER
+17 WRITE !,"There are ",+^TMP("DILIST",$JOB,0)," matches to '",PSBVAL,"'."
+18 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("DILIST",$JOB,2,PSBX))
if 'PSBX
QUIT
Begin DoDot:1
+19 WRITE !!,"MATCH #:..................",PSBX
+20 WRITE !,"IEN:......................",^TMP("DILIST",$JOB,2,PSBX)
+21 WRITE !,"NAME:.....................",^TMP("DILIST",$JOB,1,PSBX)
+22 SET PSBFLD=0
+23 FOR
SET PSBFLD=$ORDER(^TMP("DILIST",$JOB,"ID",PSBX,PSBFLD))
if 'PSBFLD
QUIT
Begin DoDot:2
+24 DO FIELD^DID(50,PSBFLD,"","LABEL","PSBFLD")
+25 WRITE !,PSBFLD("LABEL"),":"
FOR
if $X>25
QUIT
WRITE "."
+26 WRITE ^TMP("DILIST",$JOB,"ID",PSBX,PSBFLD)
End DoDot:2
End DoDot:1
+27 KILL ^TMP("DILIST",$JOB)
+28 QUIT
+29 ;
SMED(RESULTS,PSBDATA) ; Lookup Medication
+1 IF $$GET^XPAR("DIV","PSB ROBOT RX")
IF PSBDATA?1"3"15N!(PSBDATA?1"3"17N)
IF 123[$EXTRACT(PSBDATA,12)
SET PSBDATA=$EXTRACT(PSBDATA,2,11)
+2 SET X=$$FIND1^DIC(50,"","AX",PSBDATA,"B^C")
+3 IF X<1
SET RESULTS(0)="-1^Invalid Medication Lookup"
+4 IF '$TEST
SET RESULTS(0)=X_U_$$GET1^DIQ(50,X_",",.01)
+5 QUIT
