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