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

SDAMU.m

Go to the documentation of this file.
  1. SDAMU ;ALB/MJK - AM Utilities ; 12/1/91
  1. ;;5.3;Scheduling;**63**;Aug 13, 1993
  1. ;
  1. SWITCH() ; -- date of ci switch over
  1. Q 2921001
  1. ;
  1. NOW() ; -- return current date and time (NOW)
  1. D NOW^%DTC
  1. Q %
  1. ;
  1. BARC(TTYPE,ON,OFF) ; -- barcode on/off
  1. S ON=$S($D(^%ZIS(2,TTYPE,"BAR1")):^("BAR1"),1:""),OFF=$S($D(^("BAR0")):^("BAR0"),1:"")
  1. Q ON]""&(OFF]"")
  1. ;
  1. CURRENT ; -- computed field (2.98,100)
  1. S X=$P($$STATUS^SDAM1(D0,D1,+$G(^DPT(D0,"S",D1,0)),$G(^(0))),";",3)
  1. Q
  1. ;
  1. CLINIC(SDCL) ; -- generic screen for hos. loc. entries
  1. ; input: SDCL := ifn of HOSPITAL LOCATION file
  1. ; returned := [ 0 | do not use entry ; 1 | use entry ]
  1. ;
  1. ; -- must be not be a 'non-count' clinic and must be a clinic
  1. N X S X=$G(^SC(SDCL,0)),X("OOS")=+$G(^("OOS"))
  1. Q $S($P(X,"^",17)="Y":0,X("OOS"):0,1:$P(X,"^",3)="C")
  1. ;
  1. DIV(SDCL,VAUTD,SDNAME,SDLEN) ; -- find division for clinic
  1. ; input: SDCL := clinic ifn
  1. ; VAUTD := array defined by VAUTOMA
  1. ; SDLEN := length of name to pass back [optional]
  1. ; output: SDNAME := name of division
  1. ; return: := division ifn
  1. ;
  1. N X
  1. I '$D(SDLEN) N SDLEN S SDLEN=35
  1. S X=$S('$P($G(^DG(43,1,"GL")),U,2):+$O(^DG(40.8,0)),1:+$P($G(^SC(SDCL,0)),U,15))
  1. S SDNAME=$E($S($D(^DG(40.8,X,0)):$P(^(0),U),1:"UNKNOWN"),1,SDLEN)
  1. Q $S(VAUTD=1!($D(VAUTD(X))):X,1:0)
  1. ;
  1. RT(SDRTOPT) ; -- rt call for newing and return to LM
  1. N DFN,RTE,R,RTPGM,RTJR,RTY,RTDIV,X,Y
  1. S X=$O(^DIC(19,"B",SDRTOPT,0))
  1. I +$G(^DIC(195.4,1,"UP")),X D
  1. .S X=X_";DIC(19," D EN^XQOR
  1. E D
  1. .W !!?5,"'",$P($G(XQORNOD(0)),U,3),"' is not available on your system." D PAUSE^VALM1
  1. Q
  1. ;