- 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 Jan 18, 2025@03:49:24 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 ;