HMPXGSD ; ASMR/hrubovcak - Scheduling data retrieval ;Nov 20, 2015 01:49:50
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; DE2818, code below adapted from CLINLOC^ORWU
CLINLOC(RSLT,FROM,DIR) ; return list of clinics from HOSPITAL LOCATION file (#44)
; all 3 arguments required
; RSLT=returned list (passed by reference), FROM=text to $ORDER from, DIR=$ORDER direction
; RSLT(counter) = IEN^location name
N I,IEN,LOCNM ; counter, internal entry number, location name
S I=0,LOCNM=$G(FROM)
F S LOCNM=$O(^SC("B",LOCNM),DIR) Q:LOCNM="" D ; ICR 10040
. S IEN="" F S IEN=$O(^SC("B",LOCNM,IEN),DIR) Q:'IEN D
.. Q:'($P($G(^SC(IEN,0)),U,3)="C") ; check (#2) TYPE [3S], must be clinic
.. Q:'$$ACTLOC(IEN) ; must be active
.. S I=I+1,RSLT(I)=IEN_"^"_LOCNM
;
Q
;
; DE2818, code below adapted from ACTLOC^ORWU
ACTLOC(LOC) ; Boolean function, TRUE if active hospital location
; LOC - IEN in HOSPITAL LOCATION file, ICR 10040
; IND - the "I" node, ^SC(D0,I) = (#2505) INACTIVATE DATE [1D] ^ (#2506) REACTIVATE DATE [2D] ^
; D0, X - used by WIN^DGPMDDCF
N D0,IND,X
Q:+$G(^SC(LOC,"OOS")) 0 ; (#50.01) OCCASION OF SERVICE CLINIC?, screen entry
S D0=+$G(^SC(LOC,42)) I D0 D WIN^DGPMDDCF Q 'X ; check out-of-service wards, ICR 1246
S IND=$G(^SC(LOC,"I")) Q:'IND 1 ; INACTIVATE DATE not found
I DT>$P(IND,U)&($P(IND,U,2)=""!(DT<$P(IND,U,2))) Q 0 ; check REACTIVATE DATE
Q 1 ; active
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPXGSD 1536 printed Sep 23, 2025@19:30:57 Page 2
HMPXGSD ; ASMR/hrubovcak - Scheduling data retrieval ;Nov 20, 2015 01:49:50
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; DE2818, code below adapted from CLINLOC^ORWU
CLINLOC(RSLT,FROM,DIR) ; return list of clinics from HOSPITAL LOCATION file (#44)
+1 ; all 3 arguments required
+2 ; RSLT=returned list (passed by reference), FROM=text to $ORDER from, DIR=$ORDER direction
+3 ; RSLT(counter) = IEN^location name
+4 ; counter, internal entry number, location name
NEW I,IEN,LOCNM
+5 SET I=0
SET LOCNM=$GET(FROM)
+6 ; ICR 10040
FOR
SET LOCNM=$ORDER(^SC("B",LOCNM),DIR)
if LOCNM=""
QUIT
Begin DoDot:1
+7 SET IEN=""
FOR
SET IEN=$ORDER(^SC("B",LOCNM,IEN),DIR)
if 'IEN
QUIT
Begin DoDot:2
+8 ; check (#2) TYPE [3S], must be clinic
if '($PIECE($GET(^SC(IEN,0)),U,3)="C")
QUIT
+9 ; must be active
if '$$ACTLOC(IEN)
QUIT
+10 SET I=I+1
SET RSLT(I)=IEN_"^"_LOCNM
End DoDot:2
End DoDot:1
+11 ;
+12 QUIT
+13 ;
+14 ; DE2818, code below adapted from ACTLOC^ORWU
ACTLOC(LOC) ; Boolean function, TRUE if active hospital location
+1 ; LOC - IEN in HOSPITAL LOCATION file, ICR 10040
+2 ; IND - the "I" node, ^SC(D0,I) = (#2505) INACTIVATE DATE [1D] ^ (#2506) REACTIVATE DATE [2D] ^
+3 ; D0, X - used by WIN^DGPMDDCF
+4 NEW D0,IND,X
+5 ; (#50.01) OCCASION OF SERVICE CLINIC?, screen entry
if +$GET(^SC(LOC,"OOS"))
QUIT 0
+6 ; check out-of-service wards, ICR 1246
SET D0=+$GET(^SC(LOC,42))
IF D0
DO WIN^DGPMDDCF
QUIT 'X
+7 ; INACTIVATE DATE not found
SET IND=$GET(^SC(LOC,"I"))
if 'IND
QUIT 1
+8 ; check REACTIVATE DATE
IF DT>$PIECE(IND,U)&($PIECE(IND,U,2)=""!(DT<$PIECE(IND,U,2)))
QUIT 0
+9 ; active
QUIT 1
+10 ;
