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

PSBMLU.m

Go to the documentation of this file.
  1. PSBMLU ;BIRMINGHAM/EFC - BCMA MEDICATION LOG FUNCTIONS ;6/25/10 6:44am
  1. ;;3.0;BAR CODE MED ADMIN;**6,11,13,28,42**;Mar 2004;Build 23
  1. ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
  1. ;
  1. ; Reference/IA
  1. ; DEM^VADPT/10061
  1. EN ;
  1. Q
  1. ;
  1. AUDIT(IEN,TXT,PSBTRN) ; Append and Audit
  1. D NOW^%DTC
  1. S RDAT=%
  1. D:PSBTRN="ADD COMMENT"
  1. . N XA
  1. . S XA=$O(^PSB(53.79,IEN,.3,"A"),-1)
  1. . S RDAT=$P(^PSB(53.79,IEN,.3,XA,0),U,3)
  1. D:PSBTRN="PRN EFFECTIVENESS"
  1. . S RDAT=$P(^PSB(53.79,IEN,.2),U,4)
  1. D:PSBTRN="UPDATE STATUS"
  1. . S RDAT=$P(^PSB(53.79,IEN,0),U,6)
  1. D:PSBTRN="MEDPASS"
  1. . S RDAT=$P(^PSB(53.79,IEN,0),U,6)
  1. S:'$D(^PSB(53.79,IEN,.9,0)) ^(0)="^53.799D^^"
  1. S PSBAD1=""
  1. S PSBAD1=$O(^PSB(53.79,IEN,.9,"A"),-1)+1
  1. S ^PSB(53.79,IEN,.9,PSBAD1,0)=RDAT_U_DUZ_U_TXT
  1. Q
  1. ;
  1. ERROR(PSB1,PSB2,DFN,PSB3,PSB4,PSB5,PSB6,PSB7) ;
  1. ; PSB1 = order #
  1. ; PSB2 = orderable item
  1. ; PSB3 = message to be sent
  1. ; PSB4 = schedule
  1. ; PSB5 = action date/time
  1. ; PSB6 = med log ien #
  1. ; PSB7 = user identification
  1. ; Send Error Msg about problems
  1. K PSBMG S PSBMG=$$GET^XPAR("DIV",$S($G(PSBADMER):"PSB MG ADMIN ERROR",1:"PSB MG DUE LIST ERROR"),,"E")
  1. Q:PSBMG=""
  1. S PSBMSG(1)=" The following "_$S($G(PSBADMER):"administration",1:"order")_" was NOT displayed"
  1. S PSBMSG(2)=" on the Virtual Due List"
  1. S PSBMSG(3)=" "
  1. S PSBMSG(4)=" Order Number....: "_PSB1
  1. S PSBMSG(5)=" Orderable Item..: "_PSB2
  1. N VA,VADM D DEM^VADPT
  1. S PSBMSG(6)=" Patient.........: "_VADM(1)_" ("_$TR(VA("PID"),"-")_")"
  1. S PSBMSG(7)=" Ward/Bed........: "_$$GET1^DIQ(2,DFN_",",.1)_"/"_$$GET1^DIQ(2,DFN_",",.101)
  1. S PSBMSG(8)=" Reason..........: "_PSB3
  1. S PSBMSG(9)=" Schedule........: "_PSB4
  1. I $D(PSB5) S PSBMSG(10)=" Action Dt/Tm....: "_PSB5
  1. I $D(PSB6) S PSBMSG(11)=" BCMA Med Log IEN: "_PSB6
  1. I $D(PSB7) S PSBMSG(12)=" User............: "_PSB7
  1. S XMY("G."_PSBMG)="",XMTEXT="PSBMSG(",XMSUB="BCMA - "_$S($G(PSBADMER):"Admin "_$G(PSB6),1:"Order")_" Problem"
  1. K PSBADMER
  1. D ^XMD
  1. K PSB1,PSB2,PSB3,PSB4,PSBMSG,PSBMG,XMY,XMSUB,XMTEXT
  1. Q
  1. ;
  1. MSFMSG(PSB1,PSB2,PSB3,PSB4,PSB5,PSB6,PSB7,PSB8,XFLG) ;
  1. ; PSB1 = Patient IEN
  1. ; PSB2 = Ward Location/Room
  1. ; PSB3 = Reason
  1. ; PSB4 = Type of Scan Issue
  1. ; PSB5 = Event date/time
  1. ; PSB6 = User's Comment
  1. ; PSB7 = User identification
  1. ; PSB8 = Order Number
  1. ; XFLG = -1 IF UNSUCCESSFU
  1. ;
  1. S PSBMG=$$GET^XPAR("DIV","PSB MG SCANNING FAILURES",,"E"),PSBX1=9
  1. I PSBMG="" S XFLG(0)=-1 Q
  1. I PSB2["$" S PSB2=$TR(PSB2,"$","/")
  1. K PSBDROP
  1. ;
  1. ; Dynamic - Add the 'user' to Group if not a member!
  1. I '$$MEMBER^XMXAPIG(DUZ,PSBMG) S XMY(DUZ)="",X=$$MG^XMBGRP(PSBMG,"","","",.XMY,"","") S:X>0 PSBDROP(0)=DUZ K XMY
  1. ;
  1. S PSBMSG(1)=" The following BCMA Unable to Scan event has occurred:"
  1. S PSBMSG(2)=" "
  1. S PSBMSG(3)=" User.....................: "_PSB7
  1. S PSBMSG(4)=" Date/Time of Event.......: "_PSB5
  1. N PSBDPT S PSBDPT="" I +$G(PSB1)>0 S DFN=PSB1 D DEM^VADPT S PSBDPT=VADM(1)_" ("_VA("BID")_")"
  1. S PSBMSG(5)=" Patient..................: "_PSBDPT
  1. S PSBMSG(6)=" Order Number.............: "_$S(PSB8]"":PSB8,1:"N/A")
  1. S PSBMSG(7)=" Ward Location/Room.......: "_PSB2
  1. S PSBMSG(8)=" Type of Barcode Issue....: "_PSB4
  1. I PSB4="Medication" D
  1. .I PSB8]"" D CLEAN^PSBVT,PSJ1^PSBVT(DFN,PSB8)
  1. .I $D(PSBSFUID),$G(PSBSFUID)]"" D Q
  1. ..D ;Set the Unique ID value
  1. ...I PSB6["Verify 5 Rights Override" S PSBSFUID="WARD STOCK" Q
  1. ...I PSBSFUID="WS" S PSBSFUID="WARD STOCK" Q
  1. ...I PSBSFUID["WS" S PSBSFUID="WARD STOCK ("_PSBSFUID_")"
  1. ..S PSBMSG(PSBX1)=" Unique ID................: "_PSBSFUID,PSBX1=PSBX1+1
  1. ..S PSBMSG(PSBX1)=" Orderable Item...........: "_PSBOITX,PSBX1=PSBX1+1
  1. .I '$D(PSBSFUID),$G(PSBMEDNM)]"" D Q
  1. ..I $D(PSBMEDNM) S PSBMSG(PSBX1)=" Dispense Drug............: "_PSBMEDNM_$S($G(PSBMEDOI)]"":" ("_PSBMEDOI_")",1:""),PSBX1=PSBX1+1
  1. ..I $G(PSBDOSE)]"" S PSBMSG(PSBX1)=" Dosage Ordered...........: "_PSBDOSE,PSBX1=PSBX1+1 Q
  1. .I '$D(PSBSFUID),$G(PSBMEDNM)="" D Q
  1. ..S PSBMSG(PSBX1)=" Unique ID................: WARD STOCK",PSBX1=PSBX1+1
  1. ..S PSBMSG(PSBX1)=" Orderable Item...........: "_PSBOITX,PSBX1=PSBX1+1
  1. S PSBMSG(PSBX1)=" Reason Unable to Scan....: "_PSB3,PSBX1=PSBX1+1
  1. S PSB6=$S($E(PSB6,1,2)="!~":$TR(PSB6,"!~",""),1:$TR(PSB6,"!~"," ")) I $E(PSB6,1)=" " S PSB6=$E(PSB6,2,999)
  1. S PSBX2=" User's Comment...........: "_PSB6
  1. D ;Wrap user comment if neccesary
  1. .N FL S FL=PSBX1
  1. .I $L(PSBX2)'>75 S PSBMSG(PSBX1)=PSBX2 Q
  1. .F PSBX3=1:1:$L(PSBX2," ") D
  1. ..I $L($P(PSBX2," ",1,PSBX3))>75 S PSBMSG(PSBX1)=$S(PSBX1=FL:"",1:" ")_$P(PSBX2," ",1,PSBX3-1),PSBX2=$P(PSBX2," ",PSBX3,999),PSBX1=PSBX1+1,PSBX3=1
  1. .I $L(PSBX2)>0 S PSBMSG(PSBX1+1)=" "_PSBX2
  1. S XMY("G."_PSBMG)="",XMTEXT="PSBMSG(",XMSUB="BCMA - Unable to Scan "_PSB4_": "_PSB2
  1. D ^XMD ; Send Message
  1. ;
  1. ; Clean-up
  1. K PSBMSG,XMY,XMSUB,XMTEXT,PSBX1,PSBX2,PSBX3
  1. ;
  1. ; Dynamic - Remove the user from Group if not a member originally!
  1. I $D(PSBDROP(0)) S XMY(PSBDROP(0))="",X=$$DM^XMBGRP(PSBMG,.XMY)
  1. F XX=1:1 Q:'$D(PSBDROP(XX)) S XMY(PSBDROP(XX))="",X=$$DM^XMBGRP(PSBMG,.XMY)
  1. CLEANMSF K PSBDROP,PSBMG,XMY
  1. Q
  1. ;