SDESSEARCHRCLN ;ALB/LAB,BWF - VISTA RPC SDES SEARCH RECALL CLINIC ;JAN 25,2023
;;5.3;Scheduling;**836,871**;Aug 13, 1993;Build 13
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
CLINICSEARCH(CLINICLIST,SEARCHSTRING) ;Given a search string return a clinic list that matches.
NEW ERRORS,RETURN,STRINGLENGTH,CLINICCOUNT,CLINICINFO,NUMSTR,CLINICFLIST,CLINICIEN
D VALIDATESTR(.ERRORS,.SEARCHSTRING)
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.CLINICLIST,.RETURN) Q
;
S CLINICIEN="",CLINICCOUNT=0
S STRINGLENGTH=$L(SEARCHSTRING)
S NUMSTR=(+SEARCHSTRING=SEARCHSTRING)
D:NUMSTR NUMSEARCH(.CLINICINFO,SEARCHSTRING,STRINGLENGTH,.CLINICCOUNT,.CLINICFLIST)
D:NUMSTR NUMABREVSEARCH(.CLINICINFO,SEARCHSTRING,STRINGLENGTH,.CLINICCOUNT,.CLINICFLIST)
D:'NUMSTR ALPHASEARCH(.CLINICINFO,SEARCHSTRING,STRINGLENGTH,.CLINICCOUNT,.CLINICFLIST)
D:'NUMSTR ABBREVSEARCH(.CLINICINFO,SEARCHSTRING,STRINGLENGTH,.CLINICCOUNT,.CLINICFLIST)
I 'CLINICCOUNT S CLINICINFO("Clinic")=""
D BUILDJSON(.CLINICLIST,.CLINICINFO)
Q
;
ALPHASEARCH(CLINICINFO,SEARCHSTRING,STRINGLENGTH,CLINICCOUNT,CLINICFLIST) ;
NEW CLINICIEN,CLINICNAME,INACTIVEDT,REACTIVEDT
S CLINICNAME=$O(^SC("B",SEARCHSTRING),-1)
I $E(CLINICNAME,1,STRINGLENGTH)=SEARCHSTRING D
. S CLINICNAME=$O(^SC("B",CLINICNAME),-1)
F S CLINICNAME=$O(^SC("B",CLINICNAME)) Q:CLINICNAME=""!($E(CLINICNAME,1,STRINGLENGTH)'=SEARCHSTRING) D
. Q:(CLINICCOUNT>49)
. S CLINICIEN=$O(^SC("B",CLINICNAME,""))
. Q:('$O(^SD(403.52,"B",CLINICIEN,0)))
. S INACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2505,"I")
. S REACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2506,"I")
. Q:((INACTIVEDT'="")&(INACTIVEDT<=DT))&(((REACTIVEDT'="")&(REACTIVEDT>DT))!(REACTIVEDT="")) ;do not include inactive clinics
. D BUILDCLININFO(.CLINICINFO,.CLINICIEN,.CLINICCOUNT,CLINICNAME,.CLINICFLIST)
Q
;
ABBREVSEARCH(CLINICINFO,SEARCHSTRING,STRINGLENGTH,CLINICCOUNT,CLINICFLIST) ;
NEW CLINICIEN,CLINICNAME,INACTIVEDT,REACTIVEDT
S CLINICNAME=$O(^SC("C",SEARCHSTRING),-1)
;I $E(CLINICNAME,1,STRINGLENGTH)=SEARCHSTRING D
;. S CLINICNAME=$O(^SC("C",CLINICNAME),-1)
F S CLINICNAME=$O(^SC("C",CLINICNAME)) Q:CLINICNAME=""!($E(CLINICNAME,1,STRINGLENGTH)'=SEARCHSTRING) D
. Q:(CLINICCOUNT>49)
. S CLINICIEN=""
. F S CLINICIEN=$O(^SC("C",CLINICNAME,CLINICIEN)) Q:CLINICIEN="" D
. . Q:('$O(^SD(403.52,"B",CLINICIEN,0)))
. . S INACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2505,"I")
. . S REACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2506,"I")
. . Q:((INACTIVEDT'="")&(INACTIVEDT<=DT))&(((REACTIVEDT'="")&(REACTIVEDT>DT))!(REACTIVEDT="")) ;do not include inactive clinics
. . D BUILDCLININFO(.CLINICINFO,.CLINICIEN,.CLINICCOUNT,CLINICNAME,.CLINICFLIST)
Q
;
NUMSEARCH(CLINICINFO,SEARCHSTRING,STRINGLENGTH,CLINICCOUNT,CLINICFLIST) ;
NEW CLINICIEN,CLINICNAME,INACTIVEDT,REACTIVEDT
S CLINICNAME=SEARCHSTRING
I $E(CLINICNAME,1,STRINGLENGTH)=SEARCHSTRING D
. S CLINICNAME=$O(^SC("B",CLINICNAME),-1)
F S CLINICNAME=$O(^SC("B",CLINICNAME)) Q:CLINICNAME=""!($E(CLINICNAME,1,STRINGLENGTH)>SEARCHSTRING) D
. Q:$E(CLINICNAME,1,STRINGLENGTH)'=SEARCHSTRING
. Q:(CLINICCOUNT>49)
. S CLINICIEN=$O(^SC("B",CLINICNAME,""))
. Q:('$O(^SD(403.52,"B",CLINICIEN,0)))
. S INACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2505,"I")
. S REACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2506,"I")
. Q:((INACTIVEDT'="")&(INACTIVEDT<=DT))&(((REACTIVEDT'="")&(REACTIVEDT>DT))!(REACTIVEDT="")) ;do not include inactive clinics
. D BUILDCLININFO(.CLINICINFO,.CLINICIEN,.CLINICCOUNT,CLINICNAME,.CLINICFLIST)
Q
;
NUMABREVSEARCH(CLINICINFO,SEARCHSTRING,STRINGLENGTH,CLINICCOUNT,CLINICFLIST) ;
NEW CLINICIEN,CLINICNAME,INACTIVEDT,REACTIVEDT
S CLINICNAME=SEARCHSTRING
I $E(CLINICNAME,1,STRINGLENGTH)=SEARCHSTRING D
. S CLINICNAME=$O(^SC("C",CLINICNAME),-1)
F S CLINICNAME=$O(^SC("C",CLINICNAME)) Q:CLINICNAME=""!($E(CLINICNAME,1,STRINGLENGTH)>SEARCHSTRING) D
. Q:$E(CLINICNAME,1,STRINGLENGTH)'=SEARCHSTRING
. Q:(CLINICCOUNT>49)
. S CLINICIEN=$O(^SC("C",CLINICNAME,""))
. Q:('$O(^SD(403.52,"B",CLINICIEN,0)))
. S INACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2505,"I")
. S REACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2506,"I")
. Q:((INACTIVEDT'="")&(INACTIVEDT<=DT))&(((REACTIVEDT'="")&(REACTIVEDT>DT))!(REACTIVEDT="")) ;do not include inactive clinics
. D BUILDCLININFO(.CLINICINFO,.CLINICIEN,.CLINICCOUNT,CLINICNAME,.CLINICFLIST)
Q
;
BUILDCLININFO(CLINICINFO,CLINICIEN,CLINICCOUNT,CLINICNAME,CLINICFLIST) ;
NEW STATUS,SDSTATUS,PRIMAMIS,SECONDAMIS,SDCLDATA
Q:$D(CLINICFLIST(CLINICIEN)) ;only report on clinic once
D GETS^DIQ(44,CLINICIEN,".01;1;8;200;2502;2503;60","IE","SDCLDATA")
S STATUS=$$INACTIVE^SDESUTIL(CLINICIEN,DT) ; Get status of clinic
S SDSTATUS=$S(STATUS=0:"ACTIVE",1:"INACTIVE")
S PRIMAMIS=$$STOPCODETOAMIS^SDESUTIL($G(SDCLDATA(44,CLINICIEN_",",8,"I"))) ; Get Primary AMIS Stop Code
S SECONDAMIS=$$STOPCODETOAMIS^SDESUTIL($G(SDCLDATA(44,CLINICIEN_",",2503,"I"))) ; Get Secondary AMIS Stop Code
S CLINICCOUNT=CLINICCOUNT+1
S CLINICINFO("Clinic",CLINICCOUNT,"IEN")=CLINICIEN
S CLINICINFO("Clinic",CLINICCOUNT,"Name")=$G(SDCLDATA(44,CLINICIEN_",",.01,"E"))
S CLINICINFO("Clinic",CLINICCOUNT,"Abbreviation")=$G(SDCLDATA(44,CLINICIEN_",",1,"E"))
S CLINICINFO("Clinic",CLINICCOUNT,"Status")=$G(SDSTATUS)
S CLINICINFO("Clinic",CLINICCOUNT,"Non-CountClinic")=$G(SDCLDATA(44,CLINICIEN_",",2502,"E"))
S CLINICINFO("Clinic",CLINICCOUNT,"PrimaryAMISStopCode")=PRIMAMIS
S CLINICINFO("Clinic",CLINICCOUNT,"SecondaryAMISStopCode")=SECONDAMIS
S CLINICINFO("Clinic",CLINICCOUNT,"PatientFriendlyName")=$G(SDCLDATA(44,CLINICIEN_",",60,"E"))
S CLINICINFO("Clinic",CLINICCOUNT,"PbspID")=$G(SDCLDATA(44,CLINICIEN_",",200,"E"))
S CLINICFLIST(CLINICIEN)=1
Q
;
VALIDATESTR(ERRORS,SEARCHSTRING) ;
I $G(SEARCHSTRING)="" D ERRLOG^SDESJSON(.ERRORS,231) Q
I $L(SEARCHSTRING)<3!($L(SEARCHSTRING)>30) D ERRLOG^SDESJSON(.ERRORS,230) Q
Q
;
BUILDJSON(JSONRETURN,RETURN) ;.
N JSONERROR
D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESSEARCHRCLN 6022 printed Apr 09, 2024@21:43:14 Page 2
SDESSEARCHRCLN ;ALB/LAB,BWF - VISTA RPC SDES SEARCH RECALL CLINIC ;JAN 25,2023
+1 ;;5.3;Scheduling;**836,871**;Aug 13, 1993;Build 13
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
CLINICSEARCH(CLINICLIST,SEARCHSTRING) ;Given a search string return a clinic list that matches.
+1 NEW ERRORS,RETURN,STRINGLENGTH,CLINICCOUNT,CLINICINFO,NUMSTR,CLINICFLIST,CLINICIEN
+2 DO VALIDATESTR(.ERRORS,.SEARCHSTRING)
+3 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.CLINICLIST,.RETURN)
QUIT
+4 ;
+5 SET CLINICIEN=""
SET CLINICCOUNT=0
+6 SET STRINGLENGTH=$LENGTH(SEARCHSTRING)
+7 SET NUMSTR=(+SEARCHSTRING=SEARCHSTRING)
+8 if NUMSTR
DO NUMSEARCH(.CLINICINFO,SEARCHSTRING,STRINGLENGTH,.CLINICCOUNT,.CLINICFLIST)
+9 if NUMSTR
DO NUMABREVSEARCH(.CLINICINFO,SEARCHSTRING,STRINGLENGTH,.CLINICCOUNT,.CLINICFLIST)
+10 if 'NUMSTR
DO ALPHASEARCH(.CLINICINFO,SEARCHSTRING,STRINGLENGTH,.CLINICCOUNT,.CLINICFLIST)
+11 if 'NUMSTR
DO ABBREVSEARCH(.CLINICINFO,SEARCHSTRING,STRINGLENGTH,.CLINICCOUNT,.CLINICFLIST)
+12 IF 'CLINICCOUNT
SET CLINICINFO("Clinic")=""
+13 DO BUILDJSON(.CLINICLIST,.CLINICINFO)
+14 QUIT
+15 ;
ALPHASEARCH(CLINICINFO,SEARCHSTRING,STRINGLENGTH,CLINICCOUNT,CLINICFLIST) ;
+1 NEW CLINICIEN,CLINICNAME,INACTIVEDT,REACTIVEDT
+2 SET CLINICNAME=$ORDER(^SC("B",SEARCHSTRING),-1)
+3 IF $EXTRACT(CLINICNAME,1,STRINGLENGTH)=SEARCHSTRING
Begin DoDot:1
+4 SET CLINICNAME=$ORDER(^SC("B",CLINICNAME),-1)
End DoDot:1
+5 FOR
SET CLINICNAME=$ORDER(^SC("B",CLINICNAME))
if CLINICNAME=""!($EXTRACT(CLINICNAME,1,STRINGLENGTH)'=SEARCHSTRING)
QUIT
Begin DoDot:1
+6 if (CLINICCOUNT>49)
QUIT
+7 SET CLINICIEN=$ORDER(^SC("B",CLINICNAME,""))
+8 if ('$ORDER(^SD(403.52,"B",CLINICIEN,0)))
QUIT
+9 SET INACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2505,"I")
+10 SET REACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2506,"I")
+11 ;do not include inactive clinics
if ((INACTIVEDT'="")&(INACTIVEDT<=DT))&(((REACTIVEDT'="")&(REACTIVEDT>DT))!(REACTIVEDT=""))
QUIT
+12 DO BUILDCLININFO(.CLINICINFO,.CLINICIEN,.CLINICCOUNT,CLINICNAME,.CLINICFLIST)
End DoDot:1
+13 QUIT
+14 ;
ABBREVSEARCH(CLINICINFO,SEARCHSTRING,STRINGLENGTH,CLINICCOUNT,CLINICFLIST) ;
+1 NEW CLINICIEN,CLINICNAME,INACTIVEDT,REACTIVEDT
+2 SET CLINICNAME=$ORDER(^SC("C",SEARCHSTRING),-1)
+3 ;I $E(CLINICNAME,1,STRINGLENGTH)=SEARCHSTRING D
+4 ;. S CLINICNAME=$O(^SC("C",CLINICNAME),-1)
+5 FOR
SET CLINICNAME=$ORDER(^SC("C",CLINICNAME))
if CLINICNAME=""!($EXTRACT(CLINICNAME,1,STRINGLENGTH)'=SEARCHSTRING)
QUIT
Begin DoDot:1
+6 if (CLINICCOUNT>49)
QUIT
+7 SET CLINICIEN=""
+8 FOR
SET CLINICIEN=$ORDER(^SC("C",CLINICNAME,CLINICIEN))
if CLINICIEN=""
QUIT
Begin DoDot:2
+9 if ('$ORDER(^SD(403.52,"B",CLINICIEN,0)))
QUIT
+10 SET INACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2505,"I")
+11 SET REACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2506,"I")
+12 ;do not include inactive clinics
if ((INACTIVEDT'="")&(INACTIVEDT<=DT))&(((REACTIVEDT'="")&(REACTIVEDT>DT))!(REACTIVEDT=""))
QUIT
+13 DO BUILDCLININFO(.CLINICINFO,.CLINICIEN,.CLINICCOUNT,CLINICNAME,.CLINICFLIST)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
NUMSEARCH(CLINICINFO,SEARCHSTRING,STRINGLENGTH,CLINICCOUNT,CLINICFLIST) ;
+1 NEW CLINICIEN,CLINICNAME,INACTIVEDT,REACTIVEDT
+2 SET CLINICNAME=SEARCHSTRING
+3 IF $EXTRACT(CLINICNAME,1,STRINGLENGTH)=SEARCHSTRING
Begin DoDot:1
+4 SET CLINICNAME=$ORDER(^SC("B",CLINICNAME),-1)
End DoDot:1
+5 FOR
SET CLINICNAME=$ORDER(^SC("B",CLINICNAME))
if CLINICNAME=""!($EXTRACT(CLINICNAME,1,STRINGLENGTH)>SEARCHSTRING)
QUIT
Begin DoDot:1
+6 if $EXTRACT(CLINICNAME,1,STRINGLENGTH)'=SEARCHSTRING
QUIT
+7 if (CLINICCOUNT>49)
QUIT
+8 SET CLINICIEN=$ORDER(^SC("B",CLINICNAME,""))
+9 if ('$ORDER(^SD(403.52,"B",CLINICIEN,0)))
QUIT
+10 SET INACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2505,"I")
+11 SET REACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2506,"I")
+12 ;do not include inactive clinics
if ((INACTIVEDT'="")&(INACTIVEDT<=DT))&(((REACTIVEDT'="")&(REACTIVEDT>DT))!(REACTIVEDT=""))
QUIT
+13 DO BUILDCLININFO(.CLINICINFO,.CLINICIEN,.CLINICCOUNT,CLINICNAME,.CLINICFLIST)
End DoDot:1
+14 QUIT
+15 ;
NUMABREVSEARCH(CLINICINFO,SEARCHSTRING,STRINGLENGTH,CLINICCOUNT,CLINICFLIST) ;
+1 NEW CLINICIEN,CLINICNAME,INACTIVEDT,REACTIVEDT
+2 SET CLINICNAME=SEARCHSTRING
+3 IF $EXTRACT(CLINICNAME,1,STRINGLENGTH)=SEARCHSTRING
Begin DoDot:1
+4 SET CLINICNAME=$ORDER(^SC("C",CLINICNAME),-1)
End DoDot:1
+5 FOR
SET CLINICNAME=$ORDER(^SC("C",CLINICNAME))
if CLINICNAME=""!($EXTRACT(CLINICNAME,1,STRINGLENGTH)>SEARCHSTRING)
QUIT
Begin DoDot:1
+6 if $EXTRACT(CLINICNAME,1,STRINGLENGTH)'=SEARCHSTRING
QUIT
+7 if (CLINICCOUNT>49)
QUIT
+8 SET CLINICIEN=$ORDER(^SC("C",CLINICNAME,""))
+9 if ('$ORDER(^SD(403.52,"B",CLINICIEN,0)))
QUIT
+10 SET INACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2505,"I")
+11 SET REACTIVEDT=$$GET1^DIQ(44,CLINICIEN,2506,"I")
+12 ;do not include inactive clinics
if ((INACTIVEDT'="")&(INACTIVEDT<=DT))&(((REACTIVEDT'="")&(REACTIVEDT>DT))!(REACTIVEDT=""))
QUIT
+13 DO BUILDCLININFO(.CLINICINFO,.CLINICIEN,.CLINICCOUNT,CLINICNAME,.CLINICFLIST)
End DoDot:1
+14 QUIT
+15 ;
BUILDCLININFO(CLINICINFO,CLINICIEN,CLINICCOUNT,CLINICNAME,CLINICFLIST) ;
+1 NEW STATUS,SDSTATUS,PRIMAMIS,SECONDAMIS,SDCLDATA
+2 ;only report on clinic once
if $DATA(CLINICFLIST(CLINICIEN))
QUIT
+3 DO GETS^DIQ(44,CLINICIEN,".01;1;8;200;2502;2503;60","IE","SDCLDATA")
+4 ; Get status of clinic
SET STATUS=$$INACTIVE^SDESUTIL(CLINICIEN,DT)
+5 SET SDSTATUS=$SELECT(STATUS=0:"ACTIVE",1:"INACTIVE")
+6 ; Get Primary AMIS Stop Code
SET PRIMAMIS=$$STOPCODETOAMIS^SDESUTIL($GET(SDCLDATA(44,CLINICIEN_",",8,"I")))
+7 ; Get Secondary AMIS Stop Code
SET SECONDAMIS=$$STOPCODETOAMIS^SDESUTIL($GET(SDCLDATA(44,CLINICIEN_",",2503,"I")))
+8 SET CLINICCOUNT=CLINICCOUNT+1
+9 SET CLINICINFO("Clinic",CLINICCOUNT,"IEN")=CLINICIEN
+10 SET CLINICINFO("Clinic",CLINICCOUNT,"Name")=$GET(SDCLDATA(44,CLINICIEN_",",.01,"E"))
+11 SET CLINICINFO("Clinic",CLINICCOUNT,"Abbreviation")=$GET(SDCLDATA(44,CLINICIEN_",",1,"E"))
+12 SET CLINICINFO("Clinic",CLINICCOUNT,"Status")=$GET(SDSTATUS)
+13 SET CLINICINFO("Clinic",CLINICCOUNT,"Non-CountClinic")=$GET(SDCLDATA(44,CLINICIEN_",",2502,"E"))
+14 SET CLINICINFO("Clinic",CLINICCOUNT,"PrimaryAMISStopCode")=PRIMAMIS
+15 SET CLINICINFO("Clinic",CLINICCOUNT,"SecondaryAMISStopCode")=SECONDAMIS
+16 SET CLINICINFO("Clinic",CLINICCOUNT,"PatientFriendlyName")=$GET(SDCLDATA(44,CLINICIEN_",",60,"E"))
+17 SET CLINICINFO("Clinic",CLINICCOUNT,"PbspID")=$GET(SDCLDATA(44,CLINICIEN_",",200,"E"))
+18 SET CLINICFLIST(CLINICIEN)=1
+19 QUIT
+20 ;
VALIDATESTR(ERRORS,SEARCHSTRING) ;
+1 IF $GET(SEARCHSTRING)=""
DO ERRLOG^SDESJSON(.ERRORS,231)
QUIT
+2 IF $LENGTH(SEARCHSTRING)<3!($LENGTH(SEARCHSTRING)>30)
DO ERRLOG^SDESJSON(.ERRORS,230)
QUIT
+3 QUIT
+4 ;
BUILDJSON(JSONRETURN,RETURN) ;.
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
+3 QUIT
+4 ;
