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

PSBMLEN.m

Go to the documentation of this file.
  1. PSBMLEN ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;03/06/16 3:06pm
  1. ;;3.0;BAR CODE MED ADMIN;**4,9,19,75,83,114**;Mar 2004;Build 3
  1. ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
  1. ;
  1. ; Reference/IA
  1. ; EN^PSJBCMA/2828
  1. ; ENE^PSJBCMA4/3416
  1. ; ENR^PSJBCMA4/3416
  1. ; ^XUSEC/10076
  1. ; ^DPT/10035
  1. ; $$GET^XPAR/2263
  1. ; HLP^DDSUTL/10150
  1. ;
  1. ;*83 - For MRR meds get remove string and print in 4 digit format.
  1. ; Always print admin string in 4 digit format for all meds
  1. EN ;
  1. N PSBCNT,PSBDT,PSBERR,PSBFORM,PSBMED,PSBNOW,PSBSCHT,PSBVARD,PSBX,PSBFREQ,PSBFLAG
  1. K ^TMP("PSB",$J),^TMP("PSJ",$J),PSBREC
  1. W @IOF,!,"Manual Medication Entry",!
  1. I $D(^XUSEC("PSB READ ONLY",DUZ)) W !,"This option is NOT AVAILABLE in PSB READ ONLY mode.",! Q
  1. W !,"Notice: No validation of medications is done with this option."
  1. W !,"Entries in the Med Log created with this option will reflect this"
  1. W !,"in the comments.",!!
  1. S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: "
  1. D ^DIC K DIC Q:+Y<1
  1. S DFN=+Y
  1. D EN1
  1. K ^TMP("PSBO",$J)
  1. Q
  1. ;
  1. EN1 ;
  1. S %DT="AEQ",%DT("B")="Today",%DT("A")="Select Orders From Date: "
  1. D ^%DT Q:+Y<1 S PSBDT=+Y
  1. W !,"Searching for Orders..."
  1. K ^TMP("PSJ",$J)
  1. D EN^PSJBCMA(DFN,PSBDT,"")
  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. .D CLEAN^PSBVT,PSJ^PSBVT(PSBX)
  1. .Q:PSBONX?.N1"P" ; No Pending Yet
  1. .I "PCS"'[PSBIVT,PSBONX'["U" Q
  1. .I PSBIVT["S",PSBISYR'=1 Q ; allow intermittent syringe only
  1. .I PSBIVT["C",PSBCHEMT'="P",PSBISYR'=1 Q
  1. .I PSBIVT["C",PSBCHEMT="A" Q ; allow Chemo with intermittent syringe or Piggyback type only
  1. .K ^TMP("PSBO",$J)
  1. .S PSBOUT=0
  1. .D:PSBSCHT="C"
  1. ..;Calculate admin times based on Frequency from IPM
  1. ..S (PSBYES,PSBODD)=0
  1. ..S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
  1. ..I PSBYES,PSBADST="" S PSBOUT=1 Q
  1. ..I PSBSCH?2.4N.E S PSBYES=1
  1. ..S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
  1. ..I PSBFREQ="O" S PSBYES=1
  1. ..I 'PSBYES,PSBADST="",PSBFREQ<1 S PSBOUT=1 Q
  1. ..I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
  1. ..I PSBODD,PSBADST'="" S PSBOUT=1 Q
  1. ..I PSBADST="" S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBDT)
  1. ..E K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
  1. ..F PSBY=1:1 Q:$P(PSBADST,"-",PSBY)="" I ($P(PSBADST,"-",PSBY)'?2N)&($P(PSBADST,"-",PSBY)'?4N) S PSBOUT=1 Q ; Validate time(s)
  1. .Q:PSBOUT
  1. .Q:PSBOST>PSBNOW ; Future Start Date
  1. .I PSBSCHT="O" S (PSBGVN,X,Y)="" D I (PSBGVN)!(PSBNGF) K PSBGVN,X,Y Q
  1. ..F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
  1. ...F S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y S:($P(^PSB(53.79,Y,.1),U)=PSBONX)&($P(^PSB(53.79,Y,0),U,9)'="N") PSBGVN=1,(X,Y)=0
  1. .I PSBSCHT="OC" S (PSBGVN,X,Y)="" D I PSBGVN K PSBGVN,X,Y Q
  1. ..F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
  1. ...F S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y S:($P(^PSB(53.79,Y,.1),U)=PSBONX)&($P(^PSB(53.79,Y,0),U,9)'="N") PSBGVN=1,(X,Y)=0
  1. ..S PSBGVN=PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL")) Q:PSBGVN
  1. ..I PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") S PSBGVN=1 Q ;Add On Call pharmacy status, PSB*3*75
  1. ..I PSBNGF S PSBGVN=1 Q
  1. .S ^TMP("PSB",$J,PSBSCHT,PSBOITX,PSBX)=PSBONX_U_PSBADST_U_PSBOST_U_PSBOSP_U_PSBOSTS_U_PSBRMST_U_PSBDOA_U_PSBMRRFL_U_PSBOPRSP ;*83
  1. I PSBERR W ! K DIR S DIR(0)="E" D ^DIR Q:Y="^"
  1. ;
  1. EN2 ;
  1. W $$HDR() I '$D(^TMP("PSB",$J)) W !!?5,"No Med Orders Found!",! Q
  1. S PSBSCHT="",PSBCNT=0
  1. F S PSBSCHT=$O(^TMP("PSB",$J,PSBSCHT)) Q:PSBSCHT="" D
  1. .W ! ; Line between order types
  1. .S PSBMED=""
  1. .F S PSBMED=$O(^TMP("PSB",$J,PSBSCHT,PSBMED)) Q:PSBMED="" D
  1. ..F PSBX=0:0 S PSBX=$O(^TMP("PSB",$J,PSBSCHT,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 PSBSCHT="Z" Q
  1. ...S PSBCNT=PSBCNT+1
  1. ...W !,$J(PSBCNT,2),". ",PSBSCHT,?7,PSBMED
  1. ...W ?40," (",$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,5),")"
  1. ...S Y=$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,3)
  1. ...W:$X>44 !
  1. ...W ?45,"Start: ",$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))_" "
  1. ...W $E($P(Y,".",2)_"0000",1,4)
  1. ...S Y=$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,4)
  1. ...W !?45," Stop: ",$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))_" "
  1. ...W $E($P(Y,".",2)_"0000",1,4)
  1. ...;write adim times in 4 digit format *83
  1. ...I $P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2)]"" W !?7,"Admin Times: ",$$CNVRT4^PSBUTL($P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2),"-")
  1. ...;print 4 digit format Remove string for MRR's *83
  1. ...I ($P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2)]"")!(PSBSCHT="O") D
  1. ....Q:'$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,8) ;not MRR *83
  1. ....W !?7,"Removal Times: ",$$REMSTR^PSBUTL($P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2),$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,7),PSBSCHT,$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,4),$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,9)) ;*83
  1. ...W !
  1. ...S ^TMP("PSBO",$J,PSBCNT)=$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,1)
  1. F Q:$Y>(IOSL-4) W !
  1. K DIR S DIR(0)="NO^1:"_PSBCNT_":0" D ^DIR
  1. I Y S Y=^TMP("PSBO",$J,Y) D NEW^PSBMLEN1(Y) G EN2
  1. D CLEAN^PSBVT ;*83
  1. Q
  1. ;
  1. ;
  1. HDR() ;
  1. W @IOF,"Manual Medication Entry",!," #",?4,"Sc",?7,"Medication",?41,"St"
  1. W !,$TR($J("",IOM)," ","-")
  1. Q ""
  1. ;
  1. EDIT ; Edit Medication Log
  1. N PSBAUDIT,PSBXUIT,ONX ;*83
  1. S PSBAUDIT=1,PSBXUIT="" ;*83
  1. W:'$D(^XUSEC("PSB MANAGER",DUZ)) !!?5,"Notice: You are restricted from editing any entries other than",!," those that you have created.",!
  1. S DA=""
  1. S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select Patient Name: "
  1. D ^DIC K DIC Q:+Y<1
  1. S DFN=+Y
  1. D EDIT1
  1. K PSBCNT,PSBDT,PSBIEN,PSBSRCH,PSBTMP,DA,DFN,DR,DDSFILE
  1. D CLEAN^PSBVT ;*83
  1. G EDIT
  1. ;
  1. EDIT1 ;
  1. S %DT="AEQ",%DT("A")="Select Date to Begin Searching Back From: "
  1. W !! S %DT("B")="TODAY" D ^%DT Q:+Y<1 S PSBDT=Y
  1. F D Q:'PSBDT
  1. .W @IOF,!,"Searching Date " S Y=PSBDT D D^DIQ W Y
  1. .W !," # Medication",?45,"St",?50,"D/T Given",?75,"Int"
  1. .W !,$TR($J("",IOM)," ","-")
  1. .S PSBSRCH=PSBDT+.9,PSBCNT=0
  1. .K PSBTMP
  1. .F S PSBSRCH=$O(^PSB(53.79,"AEDT",DFN,PSBSRCH),-1) Q:'PSBSRCH!(PSBSRCH<PSBDT) D
  1. ..S PSBIEN=""
  1. ..F S PSBIEN=$O(^PSB(53.79,"AEDT",DFN,PSBSRCH,PSBIEN),-1) Q:'PSBIEN D:$P(^PSB(53.79,PSBIEN,0),U,7)=DUZ!($D(^XUSEC("PSB MANAGER",DUZ)))
  1. ...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
  1. ...S PSBCNT=PSBCNT+1,PSBTMP(PSBCNT)=PSBIEN
  1. ...D:$Y>19
  1. ....W ! S DIR(0)="E" D ^DIR
  1. ....W @IOF,!,"Searching Date " S Y=PSBDT D D^DIQ W Y
  1. ....W !," # Medication",?45,"St",?50,"D/T Given",?75,"Int"
  1. ....W !,$TR($J("",IOM)," ","-")
  1. ...W !,$J(PSBCNT,2),". "
  1. ...W ?5,$$GET1^DIQ(53.79,PSBIEN_",",.08)
  1. ...I $$GET1^DIQ(53.79,PSBIEN_",",.26) W ?5," ("_$$GET1^DIQ(53.79,PSBIEN_",",.26)_")"
  1. ...W ?45,$P(^PSB(53.79,PSBIEN,0),U,9)
  1. ...W ?50,$$GET1^DIQ(53.79,PSBIEN_",",.06)
  1. ...W ?75,$$GET1^DIQ(53.79,PSBIEN_",","ACTION BY:INITIAL")
  1. .I PSBCNT D Q:Y
  1. ..W ! S DIR(0)="NO^1:"_PSBCNT_":0" D ^DIR
  1. ..I Y S DA=PSBTMP(Y),PSBDT=""
  1. .I 'PSBCNT W !!?5,"No Meds Found!"
  1. .S X1=PSBDT,X2=-1 D C^%DTC S (PSBDT,Y)=X D D^DIQ
  1. .W !!,"Continue With ",Y
  1. .S %=1 D YN^DICN I %'=1 S PSBDT=0
  1. I DA D
  1. .S PSBCOMP="",PSBDFN=$$GET1^DIQ(53.79,DA_",",.01,"I"),PSBONX=$$GET1^DIQ(53.79,DA_",",.11),PSBSTUS=$$GET1^DIQ(53.79,DA_",",.09,"I")
  1. .I PSBONX["V",PSBSTUS'="G" D Q:PSBCOMP=1
  1. ..S PSBBAGN=$$GET1^DIQ(53.79,DA_",",.26) D INFUSING^PSBVDLU2 Q:PSBCOMP=0
  1. ..I $D(PSBPORA(PSBONX)) S X="" F S X=$O(PSBPORA(PSBONX,X)),PSBBAG2=$P(PSBPORA(PSBONX,X),U,1),PSBBAGST=$P(PSBPORA(PSBONX,X),U,2) Q:PSBBAG2]""
  1. ..I PSBBAGN=PSBBAG2 S PSBCOMP=0 Q
  1. ..I (PSBBAGN'=PSBBAG2),PSBBAGST'="C" D
  1. ...W !!,"Bag "_PSBBAG2_" is marked as ",$S(PSBBAGST="I":"Infusing",PSBBAGST="S":"Stopped",1:"unk")
  1. ...W !,"This bag must be completed before bag "_PSBBAGN_" can be edited.",!!
  1. ...K PSBORA,PSBBAGN,PSBBAG2,PSBBAGST
  1. .I PSBONX["V" D PSJ1^PSBVT(PSBDFN,PSBONX)
  1. .I PSBONX["U" S ONX=PSBONX ;*83
  1. .S DDSFILE=53.79 D
  1. ..I PSBONX["U" S DR="[PSB MED LOG EDIT]" Q
  1. ..I PSBIVT["P" S DR="[PSB MED LOG EDIT]" Q
  1. ..I PSBIVT["S",PSBISYR=1 S DR="[PSB MED LOG EDIT]" Q
  1. ..I PSBIVT["C",PSBISYR=1 S DR="[PSB MED LOG EDIT]" Q
  1. ..I PSBIVT["C",PSBCHEMT="P" S DR="[PSB MED LOG EDIT]" Q
  1. ..S DR="[PSB MED LOG EDIT IV]" Q
  1. .;New Site Chk *83
  1. .F D Q:'PSBXUIT ;*83
  1. ..S PSBXUIT=""
  1. ..D ^DDS
  1. ..D PSJ1^PSBVT(DFN,ONX)
  1. ..D SITECHK^PSBMLEN1 I PSBXUIT W !,$C(7) K DIR S DIR(0)="E" D ^DIR
  1. .;
  1. .;One time order reinstated if not given
  1. .D:($P(^PSB(53.79,DA,.1),U,2)="O")&($P(^PSB(53.79,DA,0),U,9)="N") ENR^PSJBCMA4(DFN,$P(^PSB(53.79,DA,.1),U,1))
  1. .D:($P(^PSB(53.79,DA,.1),U,2)="O")&($P(^PSB(53.79,DA,0),U,9)="G") ENE^PSJBCMA4(DFN,$P(^PSB(53.79,DA,.1),U,1))
  1. Q
  1. ;
  1. VALID ;
  1. I $G(PSBSTUS)="RM","^RM^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Status of Removed cannot be changed.") Q
  1. I $G(PSBREC(7))'="Entry created with 'Manual Medication Entry' option." D Q
  1. .N DSPDRG S DSPDRG=$O(^PSB(53.79,DA,.5,0)) I 'DSPDRG Q
  1. .I ($D(^PSB(53.79,DA,.5,DSPDRG,0))),($P($G(^PSB(53.79,DA,.5,DSPDRG,0)),U,4)="PATCH") D Q
  1. ..I "^G^N^H^R^RM^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Allowed status codes are Given, Not Given, Held, Refused and Removed.")
  1. .I "^G^N^H^R^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Allowed status codes are Given, Not Given, Held, and Refused.")
  1. I "^G^H^R^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Allowed status codes are Given, Held, and Refused.") Q
  1. ;
  1. UNITS ;Check UNITS field for entry of PATCH
  1. I Y'="PATCH" Q
  1. S (DDSERROR,DDSBR)=1
  1. S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
  1. W $C(7)
  1. D HLP^DDSUTL("Field cannot be changed to PATCH")
  1. D REFRESH^DDSUTL
  1. Q
  1. ;