SDAMU.m

SDAMU ;ALB/MJK - AM Utilities ; 12/1/91

 ;;5.3;Scheduling;**63,1015**;Aug 13, 1993;Build 21

 ;

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

 ;

SDAMU     ;ALB/MJK - AM Utilities ; 12/1/91

 +1       ;;5.3;Scheduling;**63,1015**;Aug 13, 1993;Build 21

 +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       ;