SDES01C ;ALB/ANU,TAW,DJS,JAS,TJB,ANU,BWF,LAB - SEARCH SDEC RESOURCES FOR MATCHING FILE #44 DATA ;FEB 27,2024
;;5.3;Scheduling;**790,807,836,837,851,867,871,875**;Aug 13, 1993;Build 25
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
CLINICRSC(CLINICLIST,SEARCHSTRING) ;Returns first 50 matching RESOURCE names
; SEARCHSTRING - (Required) Partial name text of at least 3 characters
;RETURN:
; Successful Return:
; a JSON formatted string that contains data from the
; HOSPITAL LOCATION file
; 1. CLINIC IEN - Pointer to the HOSPITAL LOCATION file 44
; 2. CLINIC NAME - Clinic Name from HOSPITAL LOCATION file 44
; 3. CLINIC STATUS (Active/Inactive)
; 4. NON-COUNT CLINIC? (Y/N)
; 5. PRIMARY AMIS STOP CODE
; 6. SECONDARY AMIS STOP CODE
; 7. PATIENT FRIENDLY NAME
;
N CLINICFLDSARRAY,HASFIELDS,HASVALERRORS,MAXREC,RETCNT,RETURN,SDRESOURCEIEN,SDRESOURCE,SSERRORS
S MAXREC=50,RETCNT=1,SDRESOURCE=""
S SEARCHSTRING=$G(SEARCHSTRING)
;
S HASVALERRORS=$$VALIDATESRCHSTRG(.SSERRORS,SEARCHSTRING)
I HASVALERRORS M RETURN=SSERRORS
I 'HASVALERRORS D
. ;partial name lookup
. S SDRESOURCE=$$GETSUB^SDEC56(SEARCHSTRING)
. F S SDRESOURCE=$O(^SDEC(409.831,"B",SDRESOURCE)) Q:SDRESOURCE="" Q:SDRESOURCE'[SEARCHSTRING D Q:(RETCNT>MAXREC)
. . S SDRESOURCEIEN=0
. . F S SDRESOURCEIEN=$O(^SDEC(409.831,"B",SDRESOURCE,SDRESOURCEIEN)) Q:'+SDRESOURCEIEN D Q:(RETCNT>MAXREC)
. . . S HASFIELDS=$$GETCLINICFIELDS(.CLINICFLDSARRAY,SEARCHSTRING,SDRESOURCEIEN,RETCNT)
. . . I HASFIELDS M RETURN=CLINICFLDSARRAY S RETCNT=RETCNT+1
. I RETCNT'>1,'$D(RETURN("Error")) S RETURN("Resource")=""
;
;JSON format
D ENCODE^SDESJSON(.RETURN,.CLINICLIST)
Q
;
VALIDATESRCHSTRG(SSERRORS,SEARCHSTRING) ; VALIDATE SEARCH STRING
N ERRORFLAG
I SEARCHSTRING="" D
. S ERRORFLAG=1 D ERRLOG^SDESJSON(.SSERRORS,231)
I SEARCHSTRING'="",$L(SEARCHSTRING)<3!($L(SEARCHSTRING)>35) D
. S ERRORFLAG=1,SEARCHSTRING=""
. D ERRLOG^SDESJSON(.SSERRORS,230)
Q $D(ERRORFLAG)
;
GETCLINICFIELDS(CLINICFLDSARRAY,SEARCHSTRING,SDRESOURCEIEN,RETCNT) ; get data for 1 resource
N CLIENS,CREDITAMIS,FND,NONCNTCL,PTFRNDLYNM,PRIAMIS,PRIMAMIS,SDABBREVIEN
N SDCLDATA,SDCLIENS,SDCLINNAME,SDHOSLOCIEN,SDRESTYP,SDRSDATA,SDSTATUS,SECONDAMIS,STATUS
S FND=0,SDABBREVIEN=0
I '$D(^SDEC(409.831,SDRESOURCEIEN,0)) Q 0
; 867 - Comment below to return all clinics regardless of no abbreviation or too long of an abbreviation
;
; Skip Records in ABBREVIATION cross-reference
;
;S FND=$$SDCHK(SEARCHSTRING,SDRESOURCEIEN) Q:FND 0 ;Stop if 'this' record found in abbreviations
;F S SDABBREVIEN=$O(^SDEC(409.831,"C",SEARCHSTRING,SDABBREVIEN)) Q:SDABBREVIEN="" D
;. S FND=SDABBREVIEN=SDRESOURCEIEN
;Q:FND 0
;
; Collect Resource and Clinic Data for Return Array
;
S CLIENS=SDRESOURCEIEN_","
D GETS^DIQ(409.831,CLIENS,".01;.04;.012","IE","SDRSDATA")
S SDRESTYP=$G(SDRSDATA(409.831,CLIENS,.012,"I"))
Q:SDRESTYP'["SC(" 0 ; Only want Hospital Location Resources
S SDHOSLOCIEN=$G(SDRSDATA(409.831,CLIENS,.04,"I"))
S STATUS=$$INACTIVE^SDESUTIL(SDHOSLOCIEN,DT) ; Get status of clinic
S SDSTATUS=$S(STATUS=1:"INACTIVE",1:"ACTIVE")
S SDCLIENS=SDHOSLOCIEN_","
D GETS^DIQ(44,SDCLIENS,".01;8;2500;2502;2503;60","IE","SDCLDATA")
S SDCLINNAME=$G(SDCLDATA(44,SDCLIENS,.01,"E"))
I SDCLINNAME="" S SDCLINNAME="Clinic name not found for location:"_SDHOSLOCIEN
S NONCNTCL=$G(SDCLDATA(44,SDCLIENS,2502,"E"))
S PTFRNDLYNM=$G(SDCLDATA(44,SDCLIENS,60,"E"))
S PRIAMIS=$G(SDCLDATA(44,SDCLIENS,8,"I"))
S CREDITAMIS=$G(SDCLDATA(44,SDCLIENS,2503,"I"))
S PRIMAMIS=$$STOPCODETOAMIS^SDESUTIL(PRIAMIS) ; Get Primary AMIS Stop Code
S SECONDAMIS=$$STOPCODETOAMIS^SDESUTIL(CREDITAMIS) ; Get Secondary AMIS Stop Code
;
; Build the Return Array
;
S CLINICFLDSARRAY("Resource",RETCNT,"IEN")=$G(SDHOSLOCIEN)
S CLINICFLDSARRAY("Resource",RETCNT,"Name")=$G(SDCLINNAME)
S CLINICFLDSARRAY("Resource",RETCNT,"Status")=$G(SDSTATUS)
S CLINICFLDSARRAY("Resource",RETCNT,"Non-CountClinic")=$G(NONCNTCL)
S CLINICFLDSARRAY("Resource",RETCNT,"PbspID")=$$GET1^DIQ(44,SDHOSLOCIEN,200,"E")
S CLINICFLDSARRAY("Resource",RETCNT,"PrimaryAMISStopCode")=$G(PRIMAMIS)
S CLINICFLDSARRAY("Resource",RETCNT,"SecondaryAMISStopCode")=$G(SECONDAMIS)
S CLINICFLDSARRAY("Resource",RETCNT,"PatientFriendlyName")=$G(PTFRNDLYNM)
S CLINICFLDSARRAY("Resource",RETCNT,"ProhibitedClinic")=$S($G(SDCLDATA(44,SDCLIENS,2500,"E"))="YES":1,1:0)
Q 1
;
SDCHK(SEARCHSTRING,SDRESOURCEIEN) ;Stop if 'this' record found in abbreviations
N FND,SDABBREVIEN,SDABBREV
S FND=0
S SDABBREV=$$GETSUB^SDEC56(SEARCHSTRING)
F S SDABBREV=$O(^SDEC(409.831,"C",SDABBREV)) Q:SDABBREV="" Q:SDABBREV'[SEARCHSTRING D Q:+FND
. S SDABBREVIEN=0
. F S SDABBREVIEN=$O(^SDEC(409.831,"C",SDABBREV,SDABBREVIEN)) Q:'+SDABBREVIEN D Q:+FND
. . S FND=SDABBREVIEN=SDRESOURCEIEN
Q FND
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES01C 4947 printed Dec 13, 2024@02:53:11 Page 2
SDES01C ;ALB/ANU,TAW,DJS,JAS,TJB,ANU,BWF,LAB - SEARCH SDEC RESOURCES FOR MATCHING FILE #44 DATA ;FEB 27,2024
+1 ;;5.3;Scheduling;**790,807,836,837,851,867,871,875**;Aug 13, 1993;Build 25
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
CLINICRSC(CLINICLIST,SEARCHSTRING) ;Returns first 50 matching RESOURCE names
+1 ; SEARCHSTRING - (Required) Partial name text of at least 3 characters
+2 ;RETURN:
+3 ; Successful Return:
+4 ; a JSON formatted string that contains data from the
+5 ; HOSPITAL LOCATION file
+6 ; 1. CLINIC IEN - Pointer to the HOSPITAL LOCATION file 44
+7 ; 2. CLINIC NAME - Clinic Name from HOSPITAL LOCATION file 44
+8 ; 3. CLINIC STATUS (Active/Inactive)
+9 ; 4. NON-COUNT CLINIC? (Y/N)
+10 ; 5. PRIMARY AMIS STOP CODE
+11 ; 6. SECONDARY AMIS STOP CODE
+12 ; 7. PATIENT FRIENDLY NAME
+13 ;
+14 NEW CLINICFLDSARRAY,HASFIELDS,HASVALERRORS,MAXREC,RETCNT,RETURN,SDRESOURCEIEN,SDRESOURCE,SSERRORS
+15 SET MAXREC=50
SET RETCNT=1
SET SDRESOURCE=""
+16 SET SEARCHSTRING=$GET(SEARCHSTRING)
+17 ;
+18 SET HASVALERRORS=$$VALIDATESRCHSTRG(.SSERRORS,SEARCHSTRING)
+19 IF HASVALERRORS
MERGE RETURN=SSERRORS
+20 IF 'HASVALERRORS
Begin DoDot:1
+21 ;partial name lookup
+22 SET SDRESOURCE=$$GETSUB^SDEC56(SEARCHSTRING)
+23 FOR
SET SDRESOURCE=$ORDER(^SDEC(409.831,"B",SDRESOURCE))
if SDRESOURCE=""
QUIT
if SDRESOURCE'[SEARCHSTRING
QUIT
Begin DoDot:2
+24 SET SDRESOURCEIEN=0
+25 FOR
SET SDRESOURCEIEN=$ORDER(^SDEC(409.831,"B",SDRESOURCE,SDRESOURCEIEN))
if '+SDRESOURCEIEN
QUIT
Begin DoDot:3
+26 SET HASFIELDS=$$GETCLINICFIELDS(.CLINICFLDSARRAY,SEARCHSTRING,SDRESOURCEIEN,RETCNT)
+27 IF HASFIELDS
MERGE RETURN=CLINICFLDSARRAY
SET RETCNT=RETCNT+1
End DoDot:3
if (RETCNT>MAXREC)
QUIT
End DoDot:2
if (RETCNT>MAXREC)
QUIT
+28 IF RETCNT'>1
IF '$DATA(RETURN("Error"))
SET RETURN("Resource")=""
End DoDot:1
+29 ;
+30 ;JSON format
+31 DO ENCODE^SDESJSON(.RETURN,.CLINICLIST)
+32 QUIT
+33 ;
VALIDATESRCHSTRG(SSERRORS,SEARCHSTRING) ; VALIDATE SEARCH STRING
+1 NEW ERRORFLAG
+2 IF SEARCHSTRING=""
Begin DoDot:1
+3 SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.SSERRORS,231)
End DoDot:1
+4 IF SEARCHSTRING'=""
IF $LENGTH(SEARCHSTRING)<3!($LENGTH(SEARCHSTRING)>35)
Begin DoDot:1
+5 SET ERRORFLAG=1
SET SEARCHSTRING=""
+6 DO ERRLOG^SDESJSON(.SSERRORS,230)
End DoDot:1
+7 QUIT $DATA(ERRORFLAG)
+8 ;
GETCLINICFIELDS(CLINICFLDSARRAY,SEARCHSTRING,SDRESOURCEIEN,RETCNT) ; get data for 1 resource
+1 NEW CLIENS,CREDITAMIS,FND,NONCNTCL,PTFRNDLYNM,PRIAMIS,PRIMAMIS,SDABBREVIEN
+2 NEW SDCLDATA,SDCLIENS,SDCLINNAME,SDHOSLOCIEN,SDRESTYP,SDRSDATA,SDSTATUS,SECONDAMIS,STATUS
+3 SET FND=0
SET SDABBREVIEN=0
+4 IF '$DATA(^SDEC(409.831,SDRESOURCEIEN,0))
QUIT 0
+5 ; 867 - Comment below to return all clinics regardless of no abbreviation or too long of an abbreviation
+6 ;
+7 ; Skip Records in ABBREVIATION cross-reference
+8 ;
+9 ;S FND=$$SDCHK(SEARCHSTRING,SDRESOURCEIEN) Q:FND 0 ;Stop if 'this' record found in abbreviations
+10 ;F S SDABBREVIEN=$O(^SDEC(409.831,"C",SEARCHSTRING,SDABBREVIEN)) Q:SDABBREVIEN="" D
+11 ;. S FND=SDABBREVIEN=SDRESOURCEIEN
+12 ;Q:FND 0
+13 ;
+14 ; Collect Resource and Clinic Data for Return Array
+15 ;
+16 SET CLIENS=SDRESOURCEIEN_","
+17 DO GETS^DIQ(409.831,CLIENS,".01;.04;.012","IE","SDRSDATA")
+18 SET SDRESTYP=$GET(SDRSDATA(409.831,CLIENS,.012,"I"))
+19 ; Only want Hospital Location Resources
if SDRESTYP'["SC("
QUIT 0
+20 SET SDHOSLOCIEN=$GET(SDRSDATA(409.831,CLIENS,.04,"I"))
+21 ; Get status of clinic
SET STATUS=$$INACTIVE^SDESUTIL(SDHOSLOCIEN,DT)
+22 SET SDSTATUS=$SELECT(STATUS=1:"INACTIVE",1:"ACTIVE")
+23 SET SDCLIENS=SDHOSLOCIEN_","
+24 DO GETS^DIQ(44,SDCLIENS,".01;8;2500;2502;2503;60","IE","SDCLDATA")
+25 SET SDCLINNAME=$GET(SDCLDATA(44,SDCLIENS,.01,"E"))
+26 IF SDCLINNAME=""
SET SDCLINNAME="Clinic name not found for location:"_SDHOSLOCIEN
+27 SET NONCNTCL=$GET(SDCLDATA(44,SDCLIENS,2502,"E"))
+28 SET PTFRNDLYNM=$GET(SDCLDATA(44,SDCLIENS,60,"E"))
+29 SET PRIAMIS=$GET(SDCLDATA(44,SDCLIENS,8,"I"))
+30 SET CREDITAMIS=$GET(SDCLDATA(44,SDCLIENS,2503,"I"))
+31 ; Get Primary AMIS Stop Code
SET PRIMAMIS=$$STOPCODETOAMIS^SDESUTIL(PRIAMIS)
+32 ; Get Secondary AMIS Stop Code
SET SECONDAMIS=$$STOPCODETOAMIS^SDESUTIL(CREDITAMIS)
+33 ;
+34 ; Build the Return Array
+35 ;
+36 SET CLINICFLDSARRAY("Resource",RETCNT,"IEN")=$GET(SDHOSLOCIEN)
+37 SET CLINICFLDSARRAY("Resource",RETCNT,"Name")=$GET(SDCLINNAME)
+38 SET CLINICFLDSARRAY("Resource",RETCNT,"Status")=$GET(SDSTATUS)
+39 SET CLINICFLDSARRAY("Resource",RETCNT,"Non-CountClinic")=$GET(NONCNTCL)
+40 SET CLINICFLDSARRAY("Resource",RETCNT,"PbspID")=$$GET1^DIQ(44,SDHOSLOCIEN,200,"E")
+41 SET CLINICFLDSARRAY("Resource",RETCNT,"PrimaryAMISStopCode")=$GET(PRIMAMIS)
+42 SET CLINICFLDSARRAY("Resource",RETCNT,"SecondaryAMISStopCode")=$GET(SECONDAMIS)
+43 SET CLINICFLDSARRAY("Resource",RETCNT,"PatientFriendlyName")=$GET(PTFRNDLYNM)
+44 SET CLINICFLDSARRAY("Resource",RETCNT,"ProhibitedClinic")=$SELECT($GET(SDCLDATA(44,SDCLIENS,2500,"E"))="YES":1,1:0)
+45 QUIT 1
+46 ;
SDCHK(SEARCHSTRING,SDRESOURCEIEN) ;Stop if 'this' record found in abbreviations
+1 NEW FND,SDABBREVIEN,SDABBREV
+2 SET FND=0
+3 SET SDABBREV=$$GETSUB^SDEC56(SEARCHSTRING)
+4 FOR
SET SDABBREV=$ORDER(^SDEC(409.831,"C",SDABBREV))
if SDABBREV=""
QUIT
if SDABBREV'[SEARCHSTRING
QUIT
Begin DoDot:1
+5 SET SDABBREVIEN=0
+6 FOR
SET SDABBREVIEN=$ORDER(^SDEC(409.831,"C",SDABBREV,SDABBREVIEN))
if '+SDABBREVIEN
QUIT
Begin DoDot:2
+7 SET FND=SDABBREVIEN=SDRESOURCEIEN
End DoDot:2
if +FND
QUIT
End DoDot:1
if +FND
QUIT
+8 QUIT FND
