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

BOPTU.m

Go to the documentation of this file.
  1. BOPTU ;IHS/ILC/CAP - ILC RX - Utility Subroutines;26-Jan-2006 08:58;SM
  1. ;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005
  1. ;
  1. ;The following function returns the value of the Automation Site and
  1. ;a code for the type of NursingUnit/Room/Bed decoding that is
  1. ;necessary.
  1. ;
  1. ;The LOCATION DECODING TYPE is necessary because different facilities
  1. ;use room/bed and Nursing Unit in different formats. Type 1, for
  1. ;instance (Palo-Alto defaults to this type as it was installed before
  1. ;the implementation of this field) indicates that NU-Room-Bed is all
  1. ;stored in the Room-Bed field. At Hines, type 2, the NU is stripped
  1. ;of all "-"'s.
  1. ;
  1. SITE(X) ;EP - Return BOP Site, Room Decoding Code
  1. ;I X is null or zero, only the Automation site is returned
  1. ;If X is 1, the return has two "^" pieces, the second being
  1. ; the Location Decoding Code (defaulted to if none on file)
  1. ;
  1. ;If no Automation Site is on file, one is automatically created from
  1. ;the MailMan domain on file at ^XMB("NETNAME").
  1. ;Set up BOP defaults
  1. ;
  1. ; N C,Y,Z
  1. S Z=$O(^BOP(90355,0)),Y=$S(Z:$G(^(Z,"SITE")),1:""),C=Y
  1. I $P(Y,U)="" S $P(Y,U)=^XMB("NETNAME")
  1. I $P(Y,U,2)="" S $P(Y,U,2)=0
  1. ;
  1. ;Update BOP Site Parameters if pieces were null
  1. I C'=Y,Z S ^BOP(90355,Z,"SITE")=Y
  1. ;
  1. Q $S(X:Y,1:$P(Y,U))
  1. ;
  1. INTFACE(X) ;EP - Return which intererface is being used
  1. ; if none there default pyxis
  1. ; 'X' is the internal site number
  1. ;
  1. N A,B S A=$G(^BOP(90355,X,2)),B=$P(A,"^",5)
  1. Q $S(B'="":B,1:"P")
  1. ;
  1. ;BOPA = the ien of the file #90355.1
  1. FORMU(BOPA) ;EP - ef value = 'Y' if formulary, ='N' if else
  1. Q $S($P($G(^BOP(90355.1,BOPA,0)),"^",50)="Y":"Y",1:"N")
  1. ; Return most recent vital of specified type
  1. ; Return value is IEN^VALUE^DATE
  1. VITAL(DFN,TYP) ; EP
  1. N IDT,IEN,DAT,VIS
  1. S:TYP'=+TYP TYP=$O(^AUTTMSR("B",TYP,0))
  1. Q:'TYP ""
  1. S IDT=$O(^AUPNVMSR("AA",DFN,TYP,0))
  1. Q:'IDT ""
  1. S IEN=+$O(^AUPNVMSR("AA",DFN,TYP,IDT,$C(1)),-1)
  1. Q:'IEN ""
  1. S X=$G(^AUPNVMSR(IEN,0)),DAT=+$G(^(12))
  1. S:'DAT DAT=+$G(^AUPNVSIT(+$P(X,U,3),0))
  1. Q IEN_U_$P(X,U,4)_U_DAT
  1. ; Return height in cm
  1. VITCHT(VAL) ; EP
  1. Q $J($G(VAL)*2.54,0,2)
  1. ; Return weight in kg
  1. VITCWT(VAL) ; EP
  1. Q $J($G(VAL)/2.2046226,0,2)
  1. ; Return vital date in format MM/DD/YYYY
  1. VITDT(VAL) ; EP
  1. Q $$FMTE^XLFDT(VAL,"5DZ0")