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

SDESMISSIONELG.m

Go to the documentation of this file.
SDESMISSIONELG ;ALB/MGD,ANU,LAB - VISTA SCHEDULING RPCS GET MISSION ELIGIBILITY ; Nov 14, 2022
 ;;5.3;Scheduling;**814,815,818,820,826**;Aug 13, 1993;Build 18
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 ;External References
 ;-------------------
 ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
 ; Reference to ^%DT in ICR #10003
 ; Reference to $$FIND1^DIC in ICR #2051
 ;
 ; Global References Supported
 ; ----------------- ----------------- ----------
 ; ^TMP($J SACC 2.3.2.5.1
 ;
 Q
 ;
GETMISSIONELG(ELGRETURN,APPTREQIEN,PID,APPTREQTYP,SDEAS,APPTDATE,SDCLNIEN) ; Get Mission Eligibility
 ; This RPC gets User name, Keys and Scheduling Options for a given User.
 ; Input:
 ; ELGRETURN  - [required] - Success or Error message
 ; APPTREQIEN - [required] - The IEN
 ; APPTREQTYP - [required] - APPOINTMENT REQUEST type
 ; PID        - [required] - Patient Indicated Date
 ; SDEAS      - [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
 ; APPTDATE   - [required] - Date appointment is being made
 ; SDCLNIEN  - [required] - Clinic IEN
 ; 
 ;
 N HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,REQDATE,REQENDDT,SDAPPTAVAIL,SDGETCLAVL,VLDERRORS,SDSTOPCD,SDSERVICE
 N SDPRIM,SDSTOPCDIEN,SDI,REQDATENET,REQENDDTNET
 N SDCLRESIEN,PIDDATE
 N SDSTOPCDTYPE
 S (RETURN,VLDERRORS,ELGFIELDSARRAY,HASFIELDS,SDSTOPCDTYPE)=""
 ;
 S HASVLDERRORS=$$VALIDATE(.VLDERRORS,APPTREQIEN,PID,APPTREQTYP,SDEAS,.SDAPPTAVAIL,.APPTDATE)
 I HASVLDERRORS M RETURN=VLDERRORS
 I 'HASVLDERRORS S HASFIELDS=$$GETMSNELG(.ELGFIELDSARRAY,REQDATE,REQENDDT,PIDDATE,.SDAPPTAVAIL,APPTDATE)
 I HASFIELDS M RETURN=ELGFIELDSARRAY
 ;
 D BUILDJSON(.ELGRETURN,.RETURN)
 D CLEANUP
 Q
 ;
VALIDATE(ERRORS,APPTREQIEN,PID,APPTREQTYP,SDEAS,SDAPPTAVAIL,APPTDATE) ; Validate Appointment Request IEN, Request Date, PID Date
 N ERRORFLAG,SDP1,SDP2,SDP3,SDP4,SDSTRTDT,SDENDDT,SDSLOTS,SDSTOPTM,SDSTRTTM,SDTOTAL,II,SDCLNAME,SDERR
 S (SDAPPTAVAIL,SDSERVICE)=""
 ;
 ; Appointment Request IEN
 I APPTREQIEN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,3) Q $D(ERRORFLAG)
 ;
 ; Appointment Request Type
 I APPTREQTYP="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,60) Q $D(ERRORFLAG)
 I "APPT,RTC,VETERAN,CONSULT,PROCEDURE,PTCSCH"'[APPTREQTYP S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,61) Q $D(ERRORFLAG)
 I ((APPTREQTYP="APPT")!(APPTREQTYP="RTC")!(APPTREQTYP="VETERAN")) D
 . I APPTREQIEN'="",'$D(^SDEC(409.85,+APPTREQIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,4) Q
 . S REQDATE=$$GET1^DIQ(409.85,APPTREQIEN,1,"I") ;Request Start Date
 ;
 I ((APPTREQTYP="CONSULT")!(APPTREQTYP="PROCEDURE")) D
 . I APPTREQIEN'="",'$D(^GMR(123,+APPTREQIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,4) Q
 . S REQDATE=$$GET1^DIQ(123,APPTREQIEN,3,"I") ;Request Start Date
 ;
 I APPTREQTYP="PTCSCH" D
 . I APPTREQIEN'="",'$D(^SD(403.5,+APPTREQIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,4) Q
 . S REQDATE=$$GET1^DIQ(403.5,APPTREQIEN,7.5,"I") ;Request Start Date
 ;
 I $G(ERRORFLAG)=1 Q $D(ERRORFLAG)
 I $G(SDCLNIEN)="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,18) Q $D(ERRORFLAG)
 I +$G(SDCLNIEN)>0 D
 . S SDCLNAME=$$GET1^DIQ(44,SDCLNIEN_",",.01,"I") ;retrieve the clinic name
 . I SDCLNAME="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,80) Q
 . S SDCLRESIEN=$$FIND1^DIC(409.831,"","X",SDCLNAME,"","","SDERR") ;retrieve the resource IEN for the clinic
 . I $D(SDERR) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,70) Q
 I $G(SDCLRESIEN)="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,70) Q $D(ERRORFLAG)
 I $G(ERRORFLAG)=1 Q $D(ERRORFLAG)
 I $G(REQDATE)="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,157) Q $D(ERRORFLAG)
 S SDSTOPCD=$$GET1^DIQ(44,SDCLNIEN,8,"I") ;Stop code ien
 I $G(SDSTOPCD)'="" S SDSTOPCD=$$GET1^DIQ(40.7,SDSTOPCD,1,"I") ;Stop code
 I $G(SDSTOPCD)="" S SDSTOPCD=0
 ;
 ; Patient Indication Date
 S PID=$G(PID,"")
 I PID="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,159) Q $D(ERRORFLAG)
 S PIDDATE=$$ISOTFM^SDAMUTDT(PID,$G(SDCLNIEN))
 I PIDDATE=-1 S PIDDATE="",ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,160) Q $D(ERRORFLAG)
 ;
 ;Appointment Date
 S APPTDATE=$G(APPTDATE)
 I APPTDATE="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,212) Q $D(ERRORFLAG)
 S APPTDATE=$$ISOTFM^SDAMUTDT(APPTDATE,$G(SDCLNIEN))
 I APPTDATE=-1 S APPTDATE="",ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,213) Q $D(ERRORFLAG)
 ;
 S SDPRIM="N"
 S SDSTOPCDIEN=0
 S SDSTOPCDIEN=$$FIND1^DIC(409.89,"","",SDSTOPCD,"C","","SDERR")
 I SDSTOPCDIEN D
 . S SDSTOPCDTYPE=$$GET1^DIQ(409.89,SDSTOPCDIEN,2,"I")
 . I ((SDSTOPCDTYPE="P")!(SDSTOPCDTYPE="M")) S SDPRIM="Y"
 ;
 I SDPRIM="Y" S REQENDDT=$$FMADD^XLFDT(REQDATE,20) S SDSERVICE="M"
 E  S REQENDDT=$$FMADD^XLFDT(REQDATE,28)
 ;
 S SDEAS=$G(SDEAS,"")
 I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
 I SDEAS=-1 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,142) Q $D(ERRORFLAG)
 ;
 ; Determine Appointment availability is within Request start date and Request end date
 K SDTMPARY
 S SDTMPARY=$NA(^TMP($J,"CLNCAVAIL"))
 K @SDTMPARY
 S REQDATENET=$$FMTONET^SDECDATE(REQDATE,"")
 S REQENDDTNET=$$FMTONET^SDECDATE(REQENDDT,"")
 D GETSLOTS^SDEC57(SDTMPARY,SDCLRESIEN,REQDATENET,REQENDDTNET)
 ;I $O(@SDTMPARY@(""))="" D ERRLOG^SDESJSON(.ERRORS,126) S ERRORFLAG=1 Q $D(ERRORFLAG)
 I $O(@SDTMPARY@(""))="" Q $D(ERRORFLAG)
 S SDTOTAL=@SDTMPARY@("CNT")
 F II=1:1:SDTOTAL D
 . S SDP1=$P(@SDTMPARY@(II),U,2) ;start date
 . S SDP2=$P(@SDTMPARY@(II),U,3) ;end date
 . S SDP3=+$P(@SDTMPARY@(II),U,4) ;open slots available
 . S SDP4=$P(@SDTMPARY@(II),U,5) ;access type  (1=available, 2=not available, 3=cancelled)
 . ;
 . S SDSTRTDT=$$FMTISO^SDAMUTDT($P(SDP1,".")) ;start date - remove the time
 . S SDSTRTTM=$E($P(SDP1_"0000",".",2),1,4) ;start time
 . S SDSTOPTM=$E($P(SDP2_"0000",".",2),1,4) ;stop time
 . S SDSLOTS=$P(@SDTMPARY@(II),U,4)
 . S SDSLOTS=$S(SDSLOTS=" ":"",1:SDSLOTS)
 . S SDSLOTS=$S(SDP4=2:"",SDP4=3:"X",1:SDSLOTS)
 . I SDSLOTS>0 S SDAPPTAVAIL="Y"
 . S SDGETCLAVL($J,"SDESCLINICAVAIL",II)=SDSTRTDT_U_SDSTRTTM_U_SDSTOPTM_U_SDSLOTS
 K @SDTMPARY
 Q $D(ERRORFLAG)
 ;
GETMSNELG(ELGARRAY,REQDATE,REQENDDT,PIDDATE,SDAPPTAVAIL,APPTDATE) ; GET Eligibility
 N HASDATA
 S ELGARRAY("MissionEligibility","Code")="0"
 S ELGARRAY("MissionEligibility","Message")="Not Eligible-"_$S(SDSERVICE="M":"Primary Care or Mental Health",1:"Special Care")
 I APPTDATE>REQENDDT D
 .I (SDAPPTAVAIL="") D
 ..I ((PIDDATE>=REQDATE)&(PIDDATE<=REQENDDT)) D
 ...S ELGARRAY("MissionEligibility","Code")="1"
 ...S ELGARRAY("MissionEligibility","Message")="Eligible-"_$S(SDSERVICE="M":"Primary Care or Mental Health",1:"Special Care")
 S HASDATA=($D(ELGARRAY)>1)
 Q HASDATA
 ;
BUILDJSON(JSONRETURN,INPUT) ; Build JSON format
 S JSONERROR=""
 D ENCODE^XLFJSON("INPUT","JSONRETURN","JSONERROR")
 Q
 ;
CLEANUP ; Cleanup
 K HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,REQENDDT,SDAPPTAVAIL,SDGETCLAVL,SDSTOPCD,SDTMPARY
 K ERRORFLAG
 K HASDATA
 K JSONERROR
 Q