Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDES01C

SDES01C.m

Go to the documentation of this file.
SDES01C ;ALB/ANU,TAW,DJS,JAS,TJB,ANU - SEARCH SDEC RESOURCES FOR MATCHING FILE #44 DATA ;DEC 06, 2023
 ;;5.3;Scheduling;**790,807,836,837,851,867**;Aug 13, 1993;Build 8
 ;;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;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,"PrimaryAMISStopCode")=$G(PRIMAMIS)
 S CLINICFLDSARRAY("Resource",RETCNT,"SecondaryAMISStopCode")=$G(SECONDAMIS)
 S CLINICFLDSARRAY("Resource",RETCNT,"PatientFriendlyName")=$G(PTFRNDLYNM)
 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