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

PSIVLTR.m

Go to the documentation of this file.
  1. PSIVLTR ;BIR/PR-BUILD LABEL TRACKER FOR ACTIVITY LOG ;03-Aug-2012 14:34;PB
  1. ;;5.0; INPATIENT MEDICATIONS ;**3,1015**;16 DEC 97;Build 62
  1. ;This routine needs the following parameters:
  1. ;TRACK - only defined if label action is dispensed or suspended
  1. ; 1=Ind lbs, 2=Sched lbs, 3= Sus lbs, 4= Order act lab
  1. ;ACTION - What is being done with the labels
  1. ;1=Dispensed, 2=Recycled, 3=Destroyed, 4=Cancelled, 5=Suspended
  1. ;PSIVNOL- number of labels being acted on
  1. ;DFN - Patient
  1. ;ON - Order number
  1. ;L +^PS(55,DFN,"IV",0)
  1. ;
  1. ; Modified - IHS/MSC/PB -04/25/12 - Modified to add the Stability Offset Value to the Label multiple in PS(55
  1. ;
  1. S:'$D(^PS(55,DFN,"IV",+ON,"LAB",0)) ^(0)="^55.1111^^" S N=^(0)
  1. F DA=$P(N,U,3)+1 I '$D(^PS(55,DFN,"IV",+ON,"LAB",DA)) S $P(N,U,3)=DA,$P(N,U,4)=$P(N,U,4)+1,^PS(55,DFN,"IV",+ON,"LAB",0)=N Q
  1. D NOW^%DTC D @ACTION G K
  1. ;
  1. 1 ;Dispensed
  1. S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL_U_TRACK_U_$S('$D(PSIVCT):1,1:0),^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
  1. Q
  1. ;
  1. 2 ;Recycled
  1. S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL D ERROR S ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
  1. Q
  1. 3 ;Destroyed
  1. S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL D ERROR S ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
  1. Q
  1. 4 ;Cancelled
  1. S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL D ERROR S ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
  1. Q
  1. 5 ;Suspended
  1. S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL_U_TRACK,^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
  1. ;IHS/MSC/PB - 4/25/12 Next line added to compute and add the Stablity Offset Value to the Label Multiple in PS(55
  1. D OFFSET
  1. Q
  1. ERROR ;Set piece 8 if user is in the wrong IV room.
  1. I $D(E)&($D(E1)) S $P(J,U,8)=E1_" "_E
  1. Q
  1. K ;
  1. ;L -^PS(55,DFN,"IV",0) K DA,J,%,N,TRACK,ACTION
  1. K DA,J,%,N,TRACK,ACTION
  1. Q
  1. OFFSET; IHS/MSC/PB - 4/25/12 added to compute the Stability Offset Value and add to the label multiple in PS(55
  1. ;S:$P(^PS(59.5,+$G(P("IVRM")),9999999),"^")=1 OFFSET=$P(^PS(55,DFN,"IV",+ON,9999999),"^")
  1. ;IHS/MSC/PB - 08/03/12 modified the line to correct the assumption the node would always exist
  1. S:$P($G(^PS(59.5,+$G(P("IVRM")),9999999)),"^")=1 OFFSET=$P($G(^PS(55,DFN,"IV",+ON,9999999)),"^")
  1. D NOW^%DTC S DOFF=$P(%,"."),SOFF=$$FMADD^XLFDT(DOFF,$G(OFFSET),0,0,0),^PS(55,DFN,"IV",+ON,"LAB",DA,9999999)=SOFF
  1. K SOFF,DOFF,OFFSET
  1. Q