Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBMLTS

PSBMLTS.m

Go to the documentation of this file.
  1. PSBMLTS ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;Mar 2004
  1. ;;3.0;BAR CODE MED ADMIN;;Mar 2004
  1. ;
  1. ; Reference/IA
  1. ; EN^PSJBCMA/2828
  1. ; EN^PSJBCMA1/2829
  1. ; File 50/221
  1. ;
  1. EN ;
  1. N DFN,PSBCNT,PSBDT,PSBERR,PSBMED,PSBNOW,PSBSCHD,PSBVDT
  1. K ^TMP("PSB",$J),^TMP("PSJ",$J),PSBORD,PSBREC
  1. W @IOF,!,"Manual Medication Log Trouble Shooter",!!
  1. S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: "
  1. D ^DIC K DIC Q:+Y<1 S DFN=+Y
  1. K DIR S DIR(0)="DO^",DIR("A")="Select Date To Validate"
  1. D ^DIR Q:+Y<1
  1. S PSBVDT=+Y
  1. W !,"Searching for Orders..."
  1. K ^TMP("PSJ",$J)
  1. D EN^PSJBCMA(DFN,PSBVDT,"")
  1. Q:$G(^TMP("PSJ",$J,1,0))=-1
  1. S PSBERR=0
  1. D NOW^%DTC S PSBNOW=%
  1. F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
  1. .Q:$P(^TMP("PSJ",$J,PSBX,0),U,3)?.N1"P" ; No Pending Yet
  1. .K PSBORD,^TMP("PSBTMP",$J)
  1. .M PSBORD=^TMP("PSJ",$J,PSBX)
  1. .S PSBSCHD=$P(PSBORD(1),U,2)
  1. .I PSBSCHD="" D Q
  1. .I PSBSCHD="C"&($P(PSBORD(1),U,6)="") D Q
  1. ..W !!,"Notice: Order #",+$P(PSBORD(0),U,3)
  1. ..W $S($P(PSBORD(0),U,3)?.N1"U":" (UNIT DOSE) ",$P(PSBORD(0),U,3)?.N1"V":" (IV) ",1:"")
  1. ..W " doesn't have administration times"
  1. .S ^TMP("PSB",$J,PSBSCHD,$P(PSBORD(3),U,2),PSBX)=$P(PSBORD(0),U,3)_U_$P(PSBORD(1),U,6)
  1. D EN1 G EN
  1. ;
  1. EN1 ;
  1. W $$HDR() I '$D(^TMP("PSB",$J)) W !!?5,"No Med Orders Found!",! Q
  1. S PSBSCHD="",PSBCNT=0
  1. F S PSBSCHD=$O(^TMP("PSB",$J,PSBSCHD)) Q:PSBSCHD="" D
  1. .W ! ; Line between order types
  1. .S PSBMED=""
  1. .F S PSBMED=$O(^TMP("PSB",$J,PSBSCHD,PSBMED)) Q:PSBMED="" D
  1. ..F PSBX=0:0 S PSBX=$O(^TMP("PSB",$J,PSBSCHD,PSBMED,PSBX)) Q:'PSBX D
  1. ...I $Y>(IOSL-6) W ! K DIR S DIR(0)="E" D ^DIR W:Y $$HDR() I 'Y S PSBSCHD="Z" Q
  1. ...S PSBCNT=PSBCNT+1
  1. ...W !,$J(PSBCNT,2),". ",PSBSCHD,?8,PSBMED
  1. ...W ?40,$P(^TMP("PSB",$J,PSBSCHD,PSBMED,PSBX),U,1),?50,$P(^(PSBX),U,2)
  1. ...S ^TMP("PSBTMP",$J,PSBCNT)=$P(^TMP("PSB",$J,PSBSCHD,PSBMED,PSBX),U,1)
  1. F Q:$Y>(IOSL-5) W !
  1. K DIR S DIR(0)="NO^1:"_PSBCNT_":0" D ^DIR
  1. I Y S Y=^TMP("PSBTMP",$J,Y) D NEW(Y) K ^TMP("PSBTMP",$J) G EN1
  1. Q
  1. ;
  1. NEW(Y) ; Create the new entry
  1. N PSBREC
  1. K ^TMP("PSJ",$J),RESULTS
  1. W @IOF D EN^PSJBCMA1(DFN,Y)
  1. K PSBORD M PSBORD=^TMP("PSJ",$J)
  1. W !,"Order: ",$P(PSBORD(0),U,3)
  1. W !,"Medication: ",$P(PSBORD(2),U,2)
  1. W !,"Dosage: ",$P(PSBORD(2),U,3)
  1. W !,"Schedule: ",$P(PSBORD(4),U,2)
  1. W !,"Admin Times: ",$P(PSBORD(4),U,9)
  1. W !,"Start D/T: "
  1. W !,"Stop D/T: "
  1. W !!,"Is this the correct Order" S %=1 D YN^DICN Q:%'=1
  1. ;
  1. ; PRN, One-Time, On Call orders
  1. ;
  1. I $P(PSBORD(4),U,1)'="C" D
  1. .W ! S %DT="AEQR",%DT("A")="Enter the DATE/TIME of Administration: "
  1. .S %DT("B")="Now" D ^%DT Q:Y<1 S PSBDT=Y D D^DIQ
  1. .D FILE
  1. ;
  1. ; Continuous Meds
  1. ;
  1. I $P(PSBORD(4),U,1)="C" D
  1. .W ! S %DT="AEQ",%DT("A")="Enter the DATE of Administration: "
  1. .S %DT("B")="Today" D ^%DT Q:Y<1 S PSBDT=Y D D^DIQ
  1. .S X="",Y=$P(PSBORD(4),U,9)
  1. .F Z=1:1:$L(Y,"-") D
  1. ..S X=X_$S(X]"":";",1:"")_Z_":"_$P(Y,"-",Z)
  1. .K DIR S DIR(0)="S^"_X,DIR("A")="Select Administration Time"
  1. .D ^DIR Q:Y<1
  1. .S PSBDT=+(PSBDT_"."_Y(0))
  1. .S Y=PSBDT D D^DIQ
  1. .D FILE
  1. Q
  1. ;
  1. FILE ; Call the med log RPC to validate and order
  1. I $D(^PSB(53.79,"AORD",DFN,$P(PSBORD(0),U,3),PSBDT)) W !,"-1^Medication is already logged!"
  1. 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)
  1. K DIR S DIR(0)="E" D ^DIR
  1. Q
  1. ;
  1. HDR() ;
  1. W @IOF,"Medication Log Trouble Shooter",!," # "
  1. W !,$TR($J("",IOM)," ","-")
  1. Q ""
  1. ;
  1. SCANNER ; This checks the scanning mechanism
  1. N PSBVAL,PSBSCAN,PSBX,PSBFLD
  1. W ! K DIR
  1. S DIR(0)="FO^1:45",DIR("A")="Scan Medication" D ^DIR Q:Y["^"!(Y="")
  1. S PSBVAL=X K DIR
  1. W !!,"Performing 'Exact Matches' scan of Drug File..."
  1. K PSBSCAN D SMED(.PSBSCAN,X)
  1. W !!,"Results of Scan:"
  1. W $S(+PSBSCAN(0)>0:" Good",1:" Invalid")," scan value."
  1. S X="" F S X=$O(PSBSCAN(X)) Q:X="" W !!?5,PSBSCAN(X)
  1. G:+PSBSCAN(0)>0 SCANNER
  1. W !!,"Performing 'Non-Exact Match' scan on the Drug File...",!
  1. K ^TMP("DILIST",$J)
  1. ;
  1. D FIND^DIC(50,"","","AX",PSBVAL,"*","B^C")
  1. ;
  1. I +$G(^TMP("DILIST",$J,0))<1 W !!,"Nothing found in drug file matching '",PSBVAL,"'." G SCANNER
  1. W !,"There are ",+^TMP("DILIST",$J,0)," matches to '",PSBVAL,"'."
  1. F PSBX=0:0 S PSBX=$O(^TMP("DILIST",$J,2,PSBX)) Q:'PSBX D
  1. .W !!,"MATCH #:..................",PSBX
  1. .W !,"IEN:......................",^TMP("DILIST",$J,2,PSBX)
  1. .W !,"NAME:.....................",^TMP("DILIST",$J,1,PSBX)
  1. .S PSBFLD=0
  1. .F S PSBFLD=$O(^TMP("DILIST",$J,"ID",PSBX,PSBFLD)) Q:'PSBFLD D
  1. ..D FIELD^DID(50,PSBFLD,"","LABEL","PSBFLD")
  1. ..W !,PSBFLD("LABEL"),":" F Q:$X>25 W "."
  1. ..W ^TMP("DILIST",$J,"ID",PSBX,PSBFLD)
  1. K ^TMP("DILIST",$J)
  1. Q
  1. ;
  1. SMED(RESULTS,PSBDATA) ; Lookup Medication
  1. 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)
  1. S X=$$FIND1^DIC(50,"","AX",PSBDATA,"B^C")
  1. I X<1 S RESULTS(0)="-1^Invalid Medication Lookup"
  1. E S RESULTS(0)=X_U_$$GET1^DIQ(50,X_",",.01)
  1. Q