SDWU ; SLC/KCM - General Utilites for Windows Calls; 2/28/01
;;5.3;Scheduling;**262**;Aug 13, 1993
;
Q
ACTLOC(LOC) ; Function: returns TRUE if active hospital location
N D0,X I +$G(^SC(LOC,"OOS")) Q 0 ; screen out OOS entry
S D0=+$G(^SC(LOC,42)) I D0 D WIN^DGPMDDCF Q 'X ; chk out of svc wards
S X=$G(^SC(LOC,"I")) I +X=0 Q 1 ; no inactivate date
I DT>$P(X,U)&($P(X,U,2)=""!(DT<$P(X,U,2))) Q 0 ; chk reactivate date
Q 1 ; must still be active
;
CLINLOC(Y,FROM,DIR) ; Return a set of clinics from HOSPITAL LOCATION
; .Y=returned list, FROM=text to $O from, DIR=$O direction,
N I,IEN,CNT S I=0,CNT=44
F Q:I'<CNT S FROM=$O(^SC("B",FROM),DIR) Q:FROM="" D
. S IEN="" F S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN D
. . I ($P($G(^SC(IEN,0)),U,3)'="C")!('$$ACTLOC(IEN)) Q
. . S I=I+1,Y(I)=IEN_"^"_FROM
Q
INPLOC(Y,FROM,DIR) ;Return a set of wards from HOSPITAL LOCATION
; .Y=returned list, FROM=text to $O from, DIR=$O direction,
N I,IEN,CNT S I=0,CNT=44
F Q:I'<CNT S FROM=$O(^SC("B",FROM),DIR) Q:FROM="" D
. S IEN="" F S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN D
. . I ($P($G(^SC(IEN,0)),U,3)'="W")!('$$ACTLOC(IEN)) Q
. . S I=I+1,Y(I)=IEN_"^"_FROM
Q
HOSPLOC(Y,FROM,DIR) ; Return a set of locations from HOSPITAL LOCATION
; .Y=returned list, FROM=text to $O from, DIR=$O direction,
N I,IEN,CNT S I=0,CNT=44
F Q:I'<CNT S FROM=$O(^SC("B",FROM),DIR) Q:FROM="" D
. S IEN="" F S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN D
. . I '$$ACTLOC(IEN) Q
. . S I=I+1,Y(I)=IEN_"^"_FROM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWU 1613 printed Dec 13, 2024@03:03:29 Page 2
SDWU ; SLC/KCM - General Utilites for Windows Calls; 2/28/01
+1 ;;5.3;Scheduling;**262**;Aug 13, 1993
+2 ;
+3 QUIT
ACTLOC(LOC) ; Function: returns TRUE if active hospital location
+1 ; screen out OOS entry
NEW D0,X
IF +$GET(^SC(LOC,"OOS"))
QUIT 0
+2 ; chk out of svc wards
SET D0=+$GET(^SC(LOC,42))
IF D0
DO WIN^DGPMDDCF
QUIT 'X
+3 ; no inactivate date
SET X=$GET(^SC(LOC,"I"))
IF +X=0
QUIT 1
+4 ; chk reactivate date
IF DT>$PIECE(X,U)&($PIECE(X,U,2)=""!(DT<$PIECE(X,U,2)))
QUIT 0
+5 ; must still be active
QUIT 1
+6 ;
CLINLOC(Y,FROM,DIR) ; Return a set of clinics from HOSPITAL LOCATION
+1 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+2 NEW I,IEN,CNT
SET I=0
SET CNT=44
+3 FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^SC("B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^SC("B",FROM,IEN),DIR)
if 'IEN
QUIT
Begin DoDot:2
+5 IF ($PIECE($GET(^SC(IEN,0)),U,3)'="C")!('$$ACTLOC(IEN))
QUIT
+6 SET I=I+1
SET Y(I)=IEN_"^"_FROM
End DoDot:2
End DoDot:1
+7 QUIT
INPLOC(Y,FROM,DIR) ;Return a set of wards from HOSPITAL LOCATION
+1 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+2 NEW I,IEN,CNT
SET I=0
SET CNT=44
+3 FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^SC("B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^SC("B",FROM,IEN),DIR)
if 'IEN
QUIT
Begin DoDot:2
+5 IF ($PIECE($GET(^SC(IEN,0)),U,3)'="W")!('$$ACTLOC(IEN))
QUIT
+6 SET I=I+1
SET Y(I)=IEN_"^"_FROM
End DoDot:2
End DoDot:1
+7 QUIT
HOSPLOC(Y,FROM,DIR) ; Return a set of locations from HOSPITAL LOCATION
+1 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+2 NEW I,IEN,CNT
SET I=0
SET CNT=44
+3 FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^SC("B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^SC("B",FROM,IEN),DIR)
if 'IEN
QUIT
Begin DoDot:2
+5 IF '$$ACTLOC(IEN)
QUIT
+6 SET I=I+1
SET Y(I)=IEN_"^"_FROM
End DoDot:2
End DoDot:1
+7 QUIT
+8
