SDAMU ;ALB/MJK - AM Utilities ; 12/1/91
;;5.3;Scheduling;**63**;Aug 13, 1993
;
SWITCH() ; -- date of ci switch over
Q 2921001
;
NOW() ; -- return current date and time (NOW)
D NOW^%DTC
Q %
;
BARC(TTYPE,ON,OFF) ; -- barcode on/off
S ON=$S($D(^%ZIS(2,TTYPE,"BAR1")):^("BAR1"),1:""),OFF=$S($D(^("BAR0")):^("BAR0"),1:"")
Q ON]""&(OFF]"")
;
CURRENT ; -- computed field (2.98,100)
S X=$P($$STATUS^SDAM1(D0,D1,+$G(^DPT(D0,"S",D1,0)),$G(^(0))),";",3)
Q
;
CLINIC(SDCL) ; -- generic screen for hos. loc. entries
; input: SDCL := ifn of HOSPITAL LOCATION file
; returned := [ 0 | do not use entry ; 1 | use entry ]
;
; -- must be not be a 'non-count' clinic and must be a clinic
N X S X=$G(^SC(SDCL,0)),X("OOS")=+$G(^("OOS"))
Q $S($P(X,"^",17)="Y":0,X("OOS"):0,1:$P(X,"^",3)="C")
;
DIV(SDCL,VAUTD,SDNAME,SDLEN) ; -- find division for clinic
; input: SDCL := clinic ifn
; VAUTD := array defined by VAUTOMA
; SDLEN := length of name to pass back [optional]
; output: SDNAME := name of division
; return: := division ifn
;
N X
I '$D(SDLEN) N SDLEN S SDLEN=35
S X=$S('$P($G(^DG(43,1,"GL")),U,2):+$O(^DG(40.8,0)),1:+$P($G(^SC(SDCL,0)),U,15))
S SDNAME=$E($S($D(^DG(40.8,X,0)):$P(^(0),U),1:"UNKNOWN"),1,SDLEN)
Q $S(VAUTD=1!($D(VAUTD(X))):X,1:0)
;
RT(SDRTOPT) ; -- rt call for newing and return to LM
N DFN,RTE,R,RTPGM,RTJR,RTY,RTDIV,X,Y
S X=$O(^DIC(19,"B",SDRTOPT,0))
I +$G(^DIC(195.4,1,"UP")),X D
.S X=X_";DIC(19," D EN^XQOR
E D
.W !!?5,"'",$P($G(XQORNOD(0)),U,3),"' is not available on your system." D PAUSE^VALM1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMU 1627 printed Dec 13, 2024@02:48:15 Page 2
SDAMU ;ALB/MJK - AM Utilities ; 12/1/91
+1 ;;5.3;Scheduling;**63**;Aug 13, 1993
+2 ;
SWITCH() ; -- date of ci switch over
+1 QUIT 2921001
+2 ;
NOW() ; -- return current date and time (NOW)
+1 DO NOW^%DTC
+2 QUIT %
+3 ;
BARC(TTYPE,ON,OFF) ; -- barcode on/off
+1 SET ON=$SELECT($DATA(^%ZIS(2,TTYPE,"BAR1")):^("BAR1"),1:"")
SET OFF=$SELECT($DATA(^("BAR0")):^("BAR0"),1:"")
+2 QUIT ON]""&(OFF]"")
+3 ;
CURRENT ; -- computed field (2.98,100)
+1 SET X=$PIECE($$STATUS^SDAM1(D0,D1,+$GET(^DPT(D0,"S",D1,0)),$GET(^(0))),";",3)
+2 QUIT
+3 ;
CLINIC(SDCL) ; -- generic screen for hos. loc. entries
+1 ; input: SDCL := ifn of HOSPITAL LOCATION file
+2 ; returned := [ 0 | do not use entry ; 1 | use entry ]
+3 ;
+4 ; -- must be not be a 'non-count' clinic and must be a clinic
+5 NEW X
SET X=$GET(^SC(SDCL,0))
SET X("OOS")=+$GET(^("OOS"))
+6 QUIT $SELECT($PIECE(X,"^",17)="Y":0,X("OOS"):0,1:$PIECE(X,"^",3)="C")
+7 ;
DIV(SDCL,VAUTD,SDNAME,SDLEN) ; -- find division for clinic
+1 ; input: SDCL := clinic ifn
+2 ; VAUTD := array defined by VAUTOMA
+3 ; SDLEN := length of name to pass back [optional]
+4 ; output: SDNAME := name of division
+5 ; return: := division ifn
+6 ;
+7 NEW X
+8 IF '$DATA(SDLEN)
NEW SDLEN
SET SDLEN=35
+9 SET X=$SELECT('$PIECE($GET(^DG(43,1,"GL")),U,2):+$ORDER(^DG(40.8,0)),1:+$PIECE($GET(^SC(SDCL,0)),U,15))
+10 SET SDNAME=$EXTRACT($SELECT($DATA(^DG(40.8,X,0)):$PIECE(^(0),U),1:"UNKNOWN"),1,SDLEN)
+11 QUIT $SELECT(VAUTD=1!($DATA(VAUTD(X))):X,1:0)
+12 ;
RT(SDRTOPT) ; -- rt call for newing and return to LM
+1 NEW DFN,RTE,R,RTPGM,RTJR,RTY,RTDIV,X,Y
+2 SET X=$ORDER(^DIC(19,"B",SDRTOPT,0))
+3 IF +$GET(^DIC(195.4,1,"UP"))
IF X
Begin DoDot:1
+4 SET X=X_";DIC(19,"
DO EN^XQOR
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 WRITE !!?5,"'",$PIECE($GET(XQORNOD(0)),U,3),"' is not available on your system."
DO PAUSE^VALM1
End DoDot:1
+7 QUIT
+8 ;
