- 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 Feb 19, 2025@00:29:59 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