- 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 Mar 13, 2025@20:59:32 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 ;
