BEDDUTL2 ;VNGT/HS/BEE-BEDD Utility Routine 2 ; 08 Nov 2011 12:00 PM
;;2.0;BEDD DASHBOARD;**3**;Jun 04, 2014;Build 12
;
Q
;
CLIN(CLIN) ;EP - Return List of Applicable Clinics
;
;Input:
; None
;
;Output:
; CLIN Array - List of Clinics
;
NEW CIEN,CTIEN,CNT
K CLIN
S CTIEN=$O(^AMER(2,"B","CLINIC TYPE","")) Q:CTIEN=""
S CNT=0,CIEN="" F S CIEN=$O(^AMER(3,"AC",CTIEN,CIEN)) Q:+CIEN=0 D
. ;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Filter out inactive
. I $$GET1^DIQ(9009083,CIEN_",",.05,"I") Q
. S CNT=CNT+1
. ;GDIT/HS/BEE 07/10/2018;CR#10213 - BEDD*2.0*3 - Now use CIEN rather then code
. ;S CLIN(CNT)=$$GET1^DIQ(9009083,CIEN_",",5,"I")_"^"_$$GET1^DIQ(9009083,CIEN_",",".01","I")
. S CLIN(CNT)=CIEN_"^"_$$GET1^DIQ(9009083,CIEN_",",".01","I")
;
Q
;
VCLIN(VIEN) ;Return the ER Clinic IEN based on the PCC visit
;
I '$G(VIEN) Q ""
;
Q $$GETCLN^AMER2A(VIEN)
;
NEW CLIN,HL
;
S CLIN=""
;
;First lookup by hospital location
S HL=$$GET1^DIQ(9000010,VIEN_",",.22,"I")
I HL]"" D
. NEW INST,DA,IENS
. ;
. ;Get the Hospital Location Pointer to file 4
. S INST=$$GET1^DIQ(44,HL_",",3,"I") Q:INST=""
. ;
. ;Now look in ER PREFERENCES for map to ER OPTION Entry
. S DA(1)=INST,DA=$O(^AMER(2.5,"C",HL,INST,"")) Q:DA=""
. S IENS=$$IENS^DILF(.DA)
. S CLIN=$$GET1^DIQ(9009082.58,IENS,.01,"I")
;
;If not set - try old method
I CLIN="" D
. NEW CL
. ;
. ;Get the clinic code from the visit
. S CL=$$GET1^DIQ(9000010,VIEN_",",.08,"I")
. I CL]"" S CLIN=$O(^AMER(3,"B",CL,""))
;
Q CLIN
;
GCLIN(CLIN) ;Return the clinic code and hospital location for the ER OPTION CIEN
;
I '$G(CLIN) Q ""
;
NEW HLOC,ICPREF
;
S HLOC=""
;
;Look for associated hospital location
S ICPREF=$O(^AMER(2.5,DUZ(2),8,"B",CLIN,"")) I ICPREF]"" D
. NEW DA,IENS
. S DA(1)=DUZ(2),DA=ICPREF,IENS=$$IENS^DILF(.DA)
. S HLOC=$$GET1^DIQ(9009082.58,IENS,".02","I")
;
;If hospital location isn't set, pull from default
S:HLOC="" HLOC=$G(^AMER(2.5,DUZ(2),"SD"))
;
I HLOC="" D Q ""
. W !,"SITE PARAMETERS have not been set up in the ERS PARAMETER option"
. W !,"No entry for EMERGENCY MEDICINE could be located"
;
;Get the clinic
S CLIN=$$GET1^DIQ(44,HLOC_",",8,"I")
;
Q CLIN_U_HLOC
BEDDUTL2 ;VNGT/HS/BEE-BEDD Utility Routine 2 ; 08 Nov 2011 12:00 PM
+1 ;;2.0;BEDD DASHBOARD;**3**;Jun 04, 2014;Build 12
+2 ;
+3 QUIT
+4 ;
CLIN(CLIN) ;EP - Return List of Applicable Clinics
+1 ;
+2 ;Input:
+3 ; None
+4 ;
+5 ;Output:
+6 ; CLIN Array - List of Clinics
+7 ;
+8 NEW CIEN,CTIEN,CNT
+9 KILL CLIN
+10 SET CTIEN=$ORDER(^AMER(2,"B","CLINIC TYPE",""))
IF CTIEN=""
QUIT
+11 SET CNT=0
SET CIEN=""
FOR
SET CIEN=$ORDER(^AMER(3,"AC",CTIEN,CIEN))
IF +CIEN=0
QUIT
Begin DoDot:1
+12 ;GDIT/HS/BEE 05/10/2018;CR#10213 - BEDD*2.0*3 - Filter out inactive
+13 IF $$GET1^DIQ(9009083,CIEN_",",.05,"I")
QUIT
+14 SET CNT=CNT+1
+15 ;GDIT/HS/BEE 07/10/2018;CR#10213 - BEDD*2.0*3 - Now use CIEN rather then code
+16 ;S CLIN(CNT)=$$GET1^DIQ(9009083,CIEN_",",5,"I")_"^"_$$GET1^DIQ(9009083,CIEN_",",".01","I")
+17 SET CLIN(CNT)=CIEN_"^"_$$GET1^DIQ(9009083,CIEN_",",".01","I")
End DoDot:1
+18 ;
+19 QUIT
+20 ;
VCLIN(VIEN) ;Return the ER Clinic IEN based on the PCC visit
+1 ;
+2 IF '$GET(VIEN)
QUIT ""
+3 ;
+4 QUIT $$GETCLN^AMER2A(VIEN)
+5 ;
+6 NEW CLIN,HL
+7 ;
+8 SET CLIN=""
+9 ;
+10 ;First lookup by hospital location
+11 SET HL=$$GET1^DIQ(9000010,VIEN_",",.22,"I")
+12 IF HL]""
Begin DoDot:1
+13 NEW INST,DA,IENS
+14 ;
+15 ;Get the Hospital Location Pointer to file 4
+16 SET INST=$$GET1^DIQ(44,HL_",",3,"I")
IF INST=""
QUIT
+17 ;
+18 ;Now look in ER PREFERENCES for map to ER OPTION Entry
+19 SET DA(1)=INST
SET DA=$ORDER(^AMER(2.5,"C",HL,INST,""))
IF DA=""
QUIT
+20 SET IENS=$$IENS^DILF(.DA)
+21 SET CLIN=$$GET1^DIQ(9009082.58,IENS,.01,"I")
End DoDot:1
+22 ;
+23 ;If not set - try old method
+24 IF CLIN=""
Begin DoDot:1
+25 NEW CL
+26 ;
+27 ;Get the clinic code from the visit
+28 SET CL=$$GET1^DIQ(9000010,VIEN_",",.08,"I")
+29 IF CL]""
SET CLIN=$ORDER(^AMER(3,"B",CL,""))
End DoDot:1
+30 ;
+31 QUIT CLIN
+32 ;
GCLIN(CLIN) ;Return the clinic code and hospital location for the ER OPTION CIEN
+1 ;
+2 IF '$GET(CLIN)
QUIT ""
+3 ;
+4 NEW HLOC,ICPREF
+5 ;
+6 SET HLOC=""
+7 ;
+8 ;Look for associated hospital location
+9 SET ICPREF=$ORDER(^AMER(2.5,DUZ(2),8,"B",CLIN,""))
IF ICPREF]""
Begin DoDot:1
+10 NEW DA,IENS
+11 SET DA(1)=DUZ(2)
SET DA=ICPREF
SET IENS=$$IENS^DILF(.DA)
+12 SET HLOC=$$GET1^DIQ(9009082.58,IENS,".02","I")
End DoDot:1
+13 ;
+14 ;If hospital location isn't set, pull from default
+15 IF HLOC=""
SET HLOC=$GET(^AMER(2.5,DUZ(2),"SD"))
+16 ;
+17 IF HLOC=""
Begin DoDot:1
+18 WRITE !,"SITE PARAMETERS have not been set up in the ERS PARAMETER option"
+19 WRITE !,"No entry for EMERGENCY MEDICINE could be located"
End DoDot:1
QUIT ""
+20 ;
+21 ;Get the clinic
+22 SET CLIN=$$GET1^DIQ(44,HLOC_",",8,"I")
+23 ;
+24 QUIT CLIN_U_HLOC
