SDESMISSIONELG ;ALB/ANU,MGD,LAB,BWF/BLB,JAS,LAB - VISTA SCHEDULING RPCS GET MISSION ELIGIBILITY ; NOV 3,2023
;;5.3;Scheduling;**814,815,818,820,826,835,842,844,845,846,864**;Aug 13, 1993;Build 15
;;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
GETMISSIONFEDT(ELGRETURN,FILEENTRYDATE,PID,APPTDATE,SDCLNIEN,SDEAS) ; Get Mission Eligibility
S FILEENTRYDATE=$P($G(FILEENTRYDATE),"T"),PID=$G(PID,"T"),APPTDATE=$G(APPTDATE,"T"),SDCLNIEN=$G(SDCLNIEN),SDEAS=$G(SDEAS)
D GETMISSIONELG(.ELGRETURN,"",PID,"",SDEAS,APPTDATE,SDCLNIEN,FILEENTRYDATE)
Q
;
GETMISSIONELG(ELGRETURN,APPTREQIEN,PID,APPTREQTYP,SDEAS,APPTDATE,SDCLNIEN,FILEENTRYDATE) ; 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 if file entry date not sent] - The IEN
; APPTREQTYP - [required if file entry date not sent] - 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
; FILEENTRYDATE - [required if APPTREQIEN and APPTREQTYP not sent] - the date the request was entered
;
;
N HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,REQDATE,REQENDDT,SDAPPTAVAIL,VLDERRORS,SDSTOPCD,SDSERVICE
N SDPRIM,SDSTOPCDIEN,SDI,REQDATENET,REQENDDTNET,APPTRETURN,NUMBER
N SDCLRESIEN,PIDDATE
N SDSTOPCDTYPE
S APPTREQIEN=$G(APPTREQIEN),PID=$G(PID),APPTREQTYP=$G(APPTREQTYP),SDEAS=$G(SDEAS),APPTDATE=$G(APPTDATE),SDCLNIEN=$G(SDCLNIEN),FILEENTRYDATE=$G(FILEENTRYDATE)
S (RETURN,VLDERRORS,ELGFIELDSARRAY,HASFIELDS,SDSTOPCDTYPE)=""
;
S NUMBER=10
S HASVLDERRORS=$$VALIDATE(.VLDERRORS,APPTREQIEN,PID,APPTREQTYP,SDEAS,.SDAPPTAVAIL,.APPTDATE,.APPTRETURN,SDCLNIEN,.NUMBER,$G(FILEENTRYDATE))
I HASVLDERRORS M RETURN=VLDERRORS
I 'HASVLDERRORS S HASFIELDS=$$GETMSNELG(.ELGFIELDSARRAY,REQDATE,REQENDDT,PIDDATE,.SDAPPTAVAIL,APPTDATE,SDCLNIEN)
I HASFIELDS M RETURN=ELGFIELDSARRAY
I $D(APPTRETURN) M RETURN=APPTRETURN
;
D BUILDJSON(.ELGRETURN,.RETURN)
D CLEANUP
Q
;
VALIDATE(ERRORS,APPTREQIEN,PID,APPTREQTYP,SDEAS,SDAPPTAVAIL,APPTDATE,APPTRETURN,SDCLNIEN,NUMBER,FILEENTRYDATE) ; Validate Appointment Request IEN, Request Date, PID Date
N ERRORFLAG,SDP1,SDP2,SDP3,SDP4,SDSTRTDT,SDENDDT,SDSLOTS,SDSTOPTM,SDSTRTTM,SDTOTAL,II,SDCLNAME,SDERR,CNT,CRSTCODEIEN,CRSTCODE,CLINLIST,SDTMPARY,FEDATEFM
S (SDAPPTAVAIL,SDSERVICE)=""
;
; Appointment Request IEN
I APPTREQIEN="",$G(FILEENTRYDATE)="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,3) Q $D(ERRORFLAG)
;
; Appointment Request Type
I $G(FILEENTRYDATE)'="" D
.S FEDATEFM=$$ISOTFM^SDAMUTDT(FILEENTRYDATE)
.I FEDATEFM<1 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,434)
I $G(ERRORFLAG) Q $D(ERRORFLAG)
I $G(FEDATEFM) S REQDATE=FEDATEFM
I '$G(REQDATE) D
.I APPTREQTYP="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,60) Q
.I "APPT,RTC,VETERAN,CONSULT,PROCEDURE,PTCSCH"'[APPTREQTYP S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,61) Q
.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
S REQDATE=$P($G(REQDATE),".",1)
;
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" D
. S REQENDDT=$$FMADD^XLFDT(REQDATE,19)
. S SDSERVICE="M"
I SDPRIM'="Y" D
. S REQENDDT=$$FMADD^XLFDT(REQDATE,27)
;
; if the PID date is after the WTS (wait time standard), quit here
I PIDDATE>REQENDDT Q $D(ERRORFLAG) ;ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,432) Q $D(ERRORFLAG)
;
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
S SDTMPARY=$NA(^TMP($J,"CLNCAVAIL"))
K @SDTMPARY
S REQDATENET=$$FMTONET^SDECDATE(REQDATE,"")
S REQENDDTNET=$$FMTONET^SDECDATE(REQENDDT,"")
; do not check availability if appointment date is within the wait time standard
I APPTDATE<REQENDDT!(APPTDATE=REQENDDT) Q ""
D GETSLOTS^SDEC57(SDTMPARY,SDCLRESIEN,REQDATENET,REQENDDTNET)
S SDTOTAL=$G(@SDTMPARY@("CNT"))
S (CNT,DONE)=0
F II=1:1:SDTOTAL D Q:DONE
.S SDP1=$P(@SDTMPARY@(II),U,2) ;start date
.Q:SDP1<$$NOW^XLFDT()
.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)
.Q:SDSLOTS=0!(SDSLOTS="")
.S SDSLOTS=$S(SDSLOTS=" ":"",1:SDSLOTS)
.S SDSLOTS=$S(SDP4=2:"",SDP4=3:"X",1:SDSLOTS)
.I "jklmnopqrstuvwxyz"[SDSLOTS S SDSLOTS=9+($F("jklmnopqrstuvwxyz",SDSLOTS)-1)
.Q:'SDSLOTS
.I SDSLOTS>0 S SDAPPTAVAIL="Y"
.S CNT=CNT+1
.I NUMBER-SDSLOTS<0 S SDSLOTS=NUMBER
.S NUMBER=$G(NUMBER)-SDSLOTS
.S APPTRETURN("MissionActAvailability",CNT,"ClinicID")=SDCLNIEN
.S APPTRETURN("MissionActAvailability",CNT,"ClinicName")=$$GET1^DIQ(44,SDCLNIEN,.01,"E")
.S APPTRETURN("MissionActAvailability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT(SDP1)
.S APPTRETURN("MissionActAvailability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT(SDP2)
.S APPTRETURN("MissionActAvailability",CNT,"AvailableSlots")=SDSLOTS
.I NUMBER<1 S DONE=1
K @SDTMPARY
; if availability was found in this clinic and at 10 available slots were found, return the results
I $G(SDAPPTAVAIL)="Y",NUMBER<1 Q ""
; no availability, or less than 10 available slots were found in target clinic, check clinics with matching stop codes
S CRSTCODEIEN=$$GET1^DIQ(44,SDCLNIEN,2503,"I")
S CRSTCODE=$$GET1^DIQ(40.7,CRSTCODEIEN,1,"E")
S CLINLIST=$NA(^TMP("SDESMISSIONAVL",$J,"CLINLIST")) K @CLINLIST
D MATCHCLIN(.CLINLIST,SDCLNIEN,SDSTOPCD,CRSTCODE)
I $D(@CLINLIST),$G(NUMBER)>0 D GETAVAIL(.APPTRETURN,.CLINLIST,REQDATE,REQENDDT,.NUMBER)
K @CLINLIST
I $D(APPTRETURN) S SDAPPTAVAIL="Y"
Q $D(ERRORFLAG)
;
MATCHCLIN(CLINLIST,SDCLNIEN,STCODE,CRSTCODE) ;
N STOPIEN,CREDSTOPIEN,CREDSTOPIENS,CRSTLOOP,CRSTOPIEN,CLINIEN,DIV,INST,CHKDIV,CHKINST
S STOPIEN=$$AMISTOSTOPCODE^SDESUTIL(STCODE)
S DIV=$$GET1^DIQ(44,SDCLNIEN,3.5,"I")
S INST=$$GET1^DIQ(40.8,DIV,.07,"I")
I $G(CRSTCODE)'="" S CREDSTOPIEN=$$AMISTOSTOPCODE^SDESUTIL(CRSTCODE)
S CLINIEN=0 F S CLINIEN=$O(^SC("AST",STOPIEN,CLINIEN)) Q:'CLINIEN D
.Q:CLINIEN=SDCLNIEN
.S CHKDIV=$$GET1^DIQ(44,CLINIEN,3.5,"I")
.S CHKINST=$$GET1^DIQ(40.8,CHKDIV,.07,"I")
.Q:CHKINST'=INST
.I $G(CREDSTOPIEN) D Q
..I $D(^SC("ACST",CREDSTOPIEN,CLINIEN)) S @CLINLIST@(CLINIEN)="" Q
.S @CLINLIST@(CLINIEN)=""
Q
GETAVAIL(RETURN,CLINLIST,START,END,NUMBER) ;
N CLINNAME,RESOURCEIEN,SDERR,CLIN,GLOB,CNT,DONE,APPTDAT,APPTSTRT,APPTEND,AVAIL,SLOTS,DONE,SDI,SDECEND,BADATE,LOOP
S (CNT,DONE)=0
I $D(RETURN) S CNT=$O(RETURN("MissionActAvailability",9999),-1)+1
S CLIN="" F S CLIN=$O(@CLINLIST@(CLIN),-1) Q:'CLIN!(DONE) D
.S GLOB=$NA(^TMP("SDESMISSIONAVL",$J,CLIN)) K @GLOB
.S BADATE=0
.S SDI=$$FMADD^XLFDT(START,-1),SDECEND=END
.F S SDI=$$FMADD^XLFDT(SDI,1) Q:SDI>$P(SDECEND,".",1)!(BADATE>0)!(DONE) D ;
..I SDI<0 S BADATE=1 Q
..I ($O(^SC(CLIN,"T",0))="")!($O(^SC(CLIN,"T",0))>SDI) Q
..I $$GET1^DIQ(44,CLIN_",",1918.5,"I")'="Y",$D(^HOLIDAY("B",SDI)) Q ;do not schedule on holidays
..Q:$$INACTIVE^SDESUTIL(CLIN,$P(SDI,".",1)) ;don't get availability if clinic inactive on day SDI
..D RESAB^SDEC57(GLOB,CLIN,SDI,SDI_"."_2359) Q:'$D(^TMP("SDESMISSIONAVL",$J,CLIN))
..S LOOP=0 F S LOOP=$O(^TMP("SDESMISSIONAVL",$J,CLIN,LOOP)) Q:'LOOP!(DONE) D
...S APPTDAT=$G(^TMP("SDESMISSIONAVL",$J,CLIN,LOOP))
...S APPTSTRT=$P(APPTDAT,U,2)
...Q:APPTSTRT<$$NOW^XLFDT
...S APPTEND=$P(APPTDAT,U,3)
...S SLOTS=$P(APPTDAT,U,4)
...Q:SLOTS=0!(SLOTS="")
...S AVAIL=$P(APPTDAT,U,5)
...S SLOTS=$S(SLOTS=" ":"",1:SLOTS)
...S SLOTS=$S(AVAIL=2:"",AVAIL=3:"X",1:SLOTS)
...I "jklmnopqrstuvwxyz"[SLOTS S SLOTS=9+($F("jklmnopqrstuvwxyz",SLOTS)-1)
...Q:'SLOTS
...S CNT=CNT+1
...I NUMBER-SLOTS<0 S SLOTS=NUMBER
...S NUMBER=$G(NUMBER)-SLOTS
...S RETURN("MissionActAvailability",CNT,"ClinicID")=CLIN
...S RETURN("MissionActAvailability",CNT,"ClinicName")=$$GET1^DIQ(44,CLIN,.01,"E")
...S RETURN("MissionActAvailability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT($P(APPTDAT,U,2))
...S RETURN("MissionActAvailability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT($P(APPTDAT,U,3))
...S RETURN("MissionActAvailability",CNT,"AvailableSlots")=SLOTS
...I NUMBER<1 S DONE=1
..K @GLOB
Q
;
GETMSNELG(ELGARRAY,REQDATE,REQENDDT,PIDDATE,SDAPPTAVAIL,APPTDATE,SDCLNIEN) ; GET Eligibility
N HASDATA,SDSTOPCD,CRSTCODEIEN
S ELGARRAY("MissionEligibility","Code")="0"
S ELGARRAY("MissionEligibility","Message")="Not Eligible-"_$S(SDSERVICE="M":"Primary Care or Mental Health",1:"Special Care")
S SDSTOPCD=$$GET1^DIQ(44,SDCLNIEN,8,"I") ;Stop code ien
S CRSTCODEIEN=$$GET1^DIQ(44,SDCLNIEN,2503,"I")
S ELGARRAY("MissionEligibility","PrimaryStopCodeName")=$$GET1^DIQ(40.7,SDSTOPCD,.01,"E")
S ELGARRAY("MissionEligibility","PrimaryStopCodeAmis")=$$GET1^DIQ(40.7,SDSTOPCD,1,"E")
S ELGARRAY("MissionEligibility","SecondaryStopCodeName")=$$GET1^DIQ(40.7,CRSTCODEIEN,.01,"E")
S ELGARRAY("MissionEligibility","SecondaryStopCodeAmis")=$$GET1^DIQ(40.7,CRSTCODEIEN,1,"E")
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,SDSTOPCD,SDTMPARY
K ERRORFLAG
K HASDATA
K JSONERROR
Q
SETMISSIONELIG(APPTIEN) ;
N REQPTR,REQFILE,REQIEN,PIDDATE,APPTDATE,ELGRETURN,APPTREQTYPE,ELIG,ELGRETURN,CLINIC,MISSIONELIG,RESOURCE,FDA
Q:'$G(APPTIEN)
S APPTDATE=$P($$GET1^DIQ(409.84,APPTIEN,.01,"I"),".")
S RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
S CLINIC=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
S APPTDATE=$$FMTISO^SDAMUTDT(APPTDATE,CLINIC)
S REQPTR=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
S REQIEN=$P(REQPTR,";")
S REQFILE=$P(REQPTR,";",2)
I REQFILE[409.85 D
.S APPTREQTYPE=$$GET1^DIQ(409.85,REQIEN,4,"I")
.S PIDDATE=$$GET1^DIQ(409.85,REQIEN,22,"I")
I REQFILE[123 D
.S APPTREQTYPE=$$UP^XLFSTR($$GET1^DIQ(123,REQIEN,13,"E"))
.S PIDDATE=$$GET1^DIQ(123,REQIEN,17,"I")
I REQFILE[403.5 D
.S APPTREQTYPE="PTCSCH"
.S PIDDATE=$$GET1^DIQ(403.5,REQIEN,5.5,"I")
.I 'PIDDATE S PIDDATE=$$GET1^DIQ(403.5,REQIEN,5,"I")
S PIDDATE=$$FMTISO^SDAMUTDT(PIDDATE,CLINIC)
D GETMISSIONELG^SDESMISSIONELG(.ELGRETURN,REQIEN,PIDDATE,APPTREQTYPE,$G(SDEAS),APPTDATE,CLINIC)
D DECODE^XLFJSON("ELGRETURN","MISSIONELIG")
S ELIG=$G(MISSIONELIG("MissionEligibility","Code"))
I ELIG S FDA(409.84,APPTIEN_",",2.1)=ELIG D FILE^DIE(,"FDA","ERR") K FDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESMISSIONELG 13723 printed Oct 16, 2024@18:57:45 Page 2
SDESMISSIONELG ;ALB/ANU,MGD,LAB,BWF/BLB,JAS,LAB - VISTA SCHEDULING RPCS GET MISSION ELIGIBILITY ; NOV 3,2023
+1 ;;5.3;Scheduling;**814,815,818,820,826,835,842,844,845,846,864**;Aug 13, 1993;Build 15
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;External References
+5 ;-------------------
+6 ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
+7 ; Reference to ^%DT in ICR #10003
+8 ; Reference to $$FIND1^DIC in ICR #2051
+9 ;
+10 ; Global References Supported
+11 ; ----------------- ----------------- ----------
+12 ; ^TMP($J SACC 2.3.2.5.1
+13 ;
+14 QUIT
GETMISSIONFEDT(ELGRETURN,FILEENTRYDATE,PID,APPTDATE,SDCLNIEN,SDEAS) ; Get Mission Eligibility
+1 SET FILEENTRYDATE=$PIECE($GET(FILEENTRYDATE),"T")
SET PID=$GET(PID,"T")
SET APPTDATE=$GET(APPTDATE,"T")
SET SDCLNIEN=$GET(SDCLNIEN)
SET SDEAS=$GET(SDEAS)
+2 DO GETMISSIONELG(.ELGRETURN,"",PID,"",SDEAS,APPTDATE,SDCLNIEN,FILEENTRYDATE)
+3 QUIT
+4 ;
GETMISSIONELG(ELGRETURN,APPTREQIEN,PID,APPTREQTYP,SDEAS,APPTDATE,SDCLNIEN,FILEENTRYDATE) ; Get Mission Eligibility
+1 ; This RPC gets User name, Keys and Scheduling Options for a given User.
+2 ; Input:
+3 ; ELGRETURN - [required] - Success or Error message
+4 ; APPTREQIEN - [required if file entry date not sent] - The IEN
+5 ; APPTREQTYP - [required if file entry date not sent] - APPOINTMENT REQUEST type
+6 ; PID - [required] - Patient Indicated Date
+7 ; SDEAS - [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
+8 ; APPTDATE - [required] - Date appointment is being made
+9 ; SDCLNIEN - [required] - Clinic IEN
+10 ; FILEENTRYDATE - [required if APPTREQIEN and APPTREQTYP not sent] - the date the request was entered
+11 ;
+12 ;
+13 NEW HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,REQDATE,REQENDDT,SDAPPTAVAIL,VLDERRORS,SDSTOPCD,SDSERVICE
+14 NEW SDPRIM,SDSTOPCDIEN,SDI,REQDATENET,REQENDDTNET,APPTRETURN,NUMBER
+15 NEW SDCLRESIEN,PIDDATE
+16 NEW SDSTOPCDTYPE
+17 SET APPTREQIEN=$GET(APPTREQIEN)
SET PID=$GET(PID)
SET APPTREQTYP=$GET(APPTREQTYP)
SET SDEAS=$GET(SDEAS)
SET APPTDATE=$GET(APPTDATE)
SET SDCLNIEN=$GET(SDCLNIEN)
SET FILEENTRYDATE=$GET(FILEENTRYDATE)
+18 SET (RETURN,VLDERRORS,ELGFIELDSARRAY,HASFIELDS,SDSTOPCDTYPE)=""
+19 ;
+20 SET NUMBER=10
+21 SET HASVLDERRORS=$$VALIDATE(.VLDERRORS,APPTREQIEN,PID,APPTREQTYP,SDEAS,.SDAPPTAVAIL,.APPTDATE,.APPTRETURN,SDCLNIEN,.NUMBER,$GET(FILEENTRYDATE))
+22 IF HASVLDERRORS
MERGE RETURN=VLDERRORS
+23 IF 'HASVLDERRORS
SET HASFIELDS=$$GETMSNELG(.ELGFIELDSARRAY,REQDATE,REQENDDT,PIDDATE,.SDAPPTAVAIL,APPTDATE,SDCLNIEN)
+24 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+25 IF $DATA(APPTRETURN)
MERGE RETURN=APPTRETURN
+26 ;
+27 DO BUILDJSON(.ELGRETURN,.RETURN)
+28 DO CLEANUP
+29 QUIT
+30 ;
VALIDATE(ERRORS,APPTREQIEN,PID,APPTREQTYP,SDEAS,SDAPPTAVAIL,APPTDATE,APPTRETURN,SDCLNIEN,NUMBER,FILEENTRYDATE) ; Validate Appointment Request IEN, Request Date, PID Date
+1 NEW ERRORFLAG,SDP1,SDP2,SDP3,SDP4,SDSTRTDT,SDENDDT,SDSLOTS,SDSTOPTM,SDSTRTTM,SDTOTAL,II,SDCLNAME,SDERR,CNT,CRSTCODEIEN,CRSTCODE,CLINLIST,SDTMPARY,FEDATEFM
+2 SET (SDAPPTAVAIL,SDSERVICE)=""
+3 ;
+4 ; Appointment Request IEN
+5 IF APPTREQIEN=""
IF $GET(FILEENTRYDATE)=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,3)
QUIT $DATA(ERRORFLAG)
+6 ;
+7 ; Appointment Request Type
+8 IF $GET(FILEENTRYDATE)'=""
Begin DoDot:1
+9 SET FEDATEFM=$$ISOTFM^SDAMUTDT(FILEENTRYDATE)
+10 IF FEDATEFM<1
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,434)
End DoDot:1
+11 IF $GET(ERRORFLAG)
QUIT $DATA(ERRORFLAG)
+12 IF $GET(FEDATEFM)
SET REQDATE=FEDATEFM
+13 IF '$GET(REQDATE)
Begin DoDot:1
+14 IF APPTREQTYP=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,60)
QUIT
+15 IF "APPT,RTC,VETERAN,CONSULT,PROCEDURE,PTCSCH"'[APPTREQTYP
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,61)
QUIT
+16 IF ((APPTREQTYP="APPT")!(APPTREQTYP="RTC")!(APPTREQTYP="VETERAN"))
Begin DoDot:2
+17 IF APPTREQIEN'=""
IF '$DATA(^SDEC(409.85,+APPTREQIEN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,4)
QUIT
+18 ;Request Start Date
SET REQDATE=$$GET1^DIQ(409.85,APPTREQIEN,1,"I")
End DoDot:2
+19 ;
+20 IF ((APPTREQTYP="CONSULT")!(APPTREQTYP="PROCEDURE"))
Begin DoDot:2
+21 IF APPTREQIEN'=""
IF '$DATA(^GMR(123,+APPTREQIEN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,4)
QUIT
+22 ;Request Start Date
SET REQDATE=$$GET1^DIQ(123,APPTREQIEN,3,"I")
End DoDot:2
+23 ;
+24 IF APPTREQTYP="PTCSCH"
Begin DoDot:2
+25 IF APPTREQIEN'=""
IF '$DATA(^SD(403.5,+APPTREQIEN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,4)
QUIT
+26 ;Request Start Date
SET REQDATE=$$GET1^DIQ(403.5,APPTREQIEN,7.5,"I")
End DoDot:2
End DoDot:1
+27 SET REQDATE=$PIECE($GET(REQDATE),".",1)
+28 ;
+29 IF $GET(ERRORFLAG)=1
QUIT $DATA(ERRORFLAG)
+30 IF $GET(SDCLNIEN)=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT $DATA(ERRORFLAG)
+31 IF +$GET(SDCLNIEN)>0
Begin DoDot:1
+32 ;retrieve the clinic name
SET SDCLNAME=$$GET1^DIQ(44,SDCLNIEN_",",.01,"I")
+33 IF SDCLNAME=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,80)
QUIT
+34 ;retrieve the resource IEN for the clinic
SET SDCLRESIEN=$$FIND1^DIC(409.831,"","X",SDCLNAME,"","","SDERR")
+35 IF $DATA(SDERR)
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,70)
QUIT
End DoDot:1
+36 IF $GET(SDCLRESIEN)=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,70)
QUIT $DATA(ERRORFLAG)
+37 IF $GET(ERRORFLAG)=1
QUIT $DATA(ERRORFLAG)
+38 IF $GET(REQDATE)=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,157)
QUIT $DATA(ERRORFLAG)
+39 ;Stop code ien
SET SDSTOPCD=$$GET1^DIQ(44,SDCLNIEN,8,"I")
+40 ;Stop code
IF $GET(SDSTOPCD)'=""
SET SDSTOPCD=$$GET1^DIQ(40.7,SDSTOPCD,1,"I")
+41 IF $GET(SDSTOPCD)=""
SET SDSTOPCD=0
+42 ;
+43 ; Patient Indication Date
+44 SET PID=$GET(PID,"")
+45 IF PID=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,159)
QUIT $DATA(ERRORFLAG)
+46 SET PIDDATE=$$ISOTFM^SDAMUTDT(PID,$GET(SDCLNIEN))
+47 IF PIDDATE=-1
SET PIDDATE=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,160)
QUIT $DATA(ERRORFLAG)
+48 ;
+49 ;Appointment Date
+50 SET APPTDATE=$GET(APPTDATE)
+51 IF APPTDATE=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,212)
QUIT $DATA(ERRORFLAG)
+52 SET APPTDATE=$$ISOTFM^SDAMUTDT(APPTDATE,$GET(SDCLNIEN))
+53 IF APPTDATE=-1
SET APPTDATE=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,213)
QUIT $DATA(ERRORFLAG)
+54 ;
+55 SET SDPRIM="N"
+56 SET SDSTOPCDIEN=0
+57 SET SDSTOPCDIEN=$$FIND1^DIC(409.89,"","",SDSTOPCD,"C","","SDERR")
+58 IF SDSTOPCDIEN
Begin DoDot:1
+59 SET SDSTOPCDTYPE=$$GET1^DIQ(409.89,SDSTOPCDIEN,2,"I")
+60 IF ((SDSTOPCDTYPE="P")!(SDSTOPCDTYPE="M"))
SET SDPRIM="Y"
End DoDot:1
+61 ;
+62 IF SDPRIM="Y"
Begin DoDot:1
+63 SET REQENDDT=$$FMADD^XLFDT(REQDATE,19)
+64 SET SDSERVICE="M"
End DoDot:1
+65 IF SDPRIM'="Y"
Begin DoDot:1
+66 SET REQENDDT=$$FMADD^XLFDT(REQDATE,27)
End DoDot:1
+67 ;
+68 ; if the PID date is after the WTS (wait time standard), quit here
+69 ;ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,432) Q $D(ERRORFLAG)
IF PIDDATE>REQENDDT
QUIT $DATA(ERRORFLAG)
+70 ;
+71 SET SDEAS=$GET(SDEAS,"")
+72 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
+73 IF SDEAS=-1
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,142)
QUIT $DATA(ERRORFLAG)
+74 ;
+75 ; Determine Appointment availability is within Request start date and Request end date
+76 SET SDTMPARY=$NAME(^TMP($JOB,"CLNCAVAIL"))
+77 KILL @SDTMPARY
+78 SET REQDATENET=$$FMTONET^SDECDATE(REQDATE,"")
+79 SET REQENDDTNET=$$FMTONET^SDECDATE(REQENDDT,"")
+80 ; do not check availability if appointment date is within the wait time standard
+81 IF APPTDATE<REQENDDT!(APPTDATE=REQENDDT)
QUIT ""
+82 DO GETSLOTS^SDEC57(SDTMPARY,SDCLRESIEN,REQDATENET,REQENDDTNET)
+83 SET SDTOTAL=$GET(@SDTMPARY@("CNT"))
+84 SET (CNT,DONE)=0
+85 FOR II=1:1:SDTOTAL
Begin DoDot:1
+86 ;start date
SET SDP1=$PIECE(@SDTMPARY@(II),U,2)
+87 if SDP1<$$NOW^XLFDT()
QUIT
+88 ;end date
SET SDP2=$PIECE(@SDTMPARY@(II),U,3)
+89 ;open slots available
SET SDP3=+$PIECE(@SDTMPARY@(II),U,4)
+90 ;access type (1=available, 2=not available, 3=cancelled)
SET SDP4=$PIECE(@SDTMPARY@(II),U,5)
+91 ;
+92 ;start date - remove the time
SET SDSTRTDT=$$FMTISO^SDAMUTDT($PIECE(SDP1,"."))
+93 ;start time
SET SDSTRTTM=$EXTRACT($PIECE(SDP1_"0000",".",2),1,4)
+94 ;stop time
SET SDSTOPTM=$EXTRACT($PIECE(SDP2_"0000",".",2),1,4)
+95 SET SDSLOTS=$PIECE(@SDTMPARY@(II),U,4)
+96 if SDSLOTS=0!(SDSLOTS="")
QUIT
+97 SET SDSLOTS=$SELECT(SDSLOTS=" ":"",1:SDSLOTS)
+98 SET SDSLOTS=$SELECT(SDP4=2:"",SDP4=3:"X",1:SDSLOTS)
+99 IF "jklmnopqrstuvwxyz"[SDSLOTS
SET SDSLOTS=9+($FIND("jklmnopqrstuvwxyz",SDSLOTS)-1)
+100 if 'SDSLOTS
QUIT
+101 IF SDSLOTS>0
SET SDAPPTAVAIL="Y"
+102 SET CNT=CNT+1
+103 IF NUMBER-SDSLOTS<0
SET SDSLOTS=NUMBER
+104 SET NUMBER=$GET(NUMBER)-SDSLOTS
+105 SET APPTRETURN("MissionActAvailability",CNT,"ClinicID")=SDCLNIEN
+106 SET APPTRETURN("MissionActAvailability",CNT,"ClinicName")=$$GET1^DIQ(44,SDCLNIEN,.01,"E")
+107 SET APPTRETURN("MissionActAvailability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT(SDP1)
+108 SET APPTRETURN("MissionActAvailability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT(SDP2)
+109 SET APPTRETURN("MissionActAvailability",CNT,"AvailableSlots")=SDSLOTS
+110 IF NUMBER<1
SET DONE=1
End DoDot:1
if DONE
QUIT
+111 KILL @SDTMPARY
+112 ; if availability was found in this clinic and at 10 available slots were found, return the results
+113 IF $GET(SDAPPTAVAIL)="Y"
IF NUMBER<1
QUIT ""
+114 ; no availability, or less than 10 available slots were found in target clinic, check clinics with matching stop codes
+115 SET CRSTCODEIEN=$$GET1^DIQ(44,SDCLNIEN,2503,"I")
+116 SET CRSTCODE=$$GET1^DIQ(40.7,CRSTCODEIEN,1,"E")
+117 SET CLINLIST=$NAME(^TMP("SDESMISSIONAVL",$JOB,"CLINLIST"))
KILL @CLINLIST
+118 DO MATCHCLIN(.CLINLIST,SDCLNIEN,SDSTOPCD,CRSTCODE)
+119 IF $DATA(@CLINLIST)
IF $GET(NUMBER)>0
DO GETAVAIL(.APPTRETURN,.CLINLIST,REQDATE,REQENDDT,.NUMBER)
+120 KILL @CLINLIST
+121 IF $DATA(APPTRETURN)
SET SDAPPTAVAIL="Y"
+122 QUIT $DATA(ERRORFLAG)
+123 ;
MATCHCLIN(CLINLIST,SDCLNIEN,STCODE,CRSTCODE) ;
+1 NEW STOPIEN,CREDSTOPIEN,CREDSTOPIENS,CRSTLOOP,CRSTOPIEN,CLINIEN,DIV,INST,CHKDIV,CHKINST
+2 SET STOPIEN=$$AMISTOSTOPCODE^SDESUTIL(STCODE)
+3 SET DIV=$$GET1^DIQ(44,SDCLNIEN,3.5,"I")
+4 SET INST=$$GET1^DIQ(40.8,DIV,.07,"I")
+5 IF $GET(CRSTCODE)'=""
SET CREDSTOPIEN=$$AMISTOSTOPCODE^SDESUTIL(CRSTCODE)
+6 SET CLINIEN=0
FOR
SET CLINIEN=$ORDER(^SC("AST",STOPIEN,CLINIEN))
if 'CLINIEN
QUIT
Begin DoDot:1
+7 if CLINIEN=SDCLNIEN
QUIT
+8 SET CHKDIV=$$GET1^DIQ(44,CLINIEN,3.5,"I")
+9 SET CHKINST=$$GET1^DIQ(40.8,CHKDIV,.07,"I")
+10 if CHKINST'=INST
QUIT
+11 IF $GET(CREDSTOPIEN)
Begin DoDot:2
+12 IF $DATA(^SC("ACST",CREDSTOPIEN,CLINIEN))
SET @CLINLIST@(CLINIEN)=""
QUIT
End DoDot:2
QUIT
+13 SET @CLINLIST@(CLINIEN)=""
End DoDot:1
+14 QUIT
GETAVAIL(RETURN,CLINLIST,START,END,NUMBER) ;
+1 NEW CLINNAME,RESOURCEIEN,SDERR,CLIN,GLOB,CNT,DONE,APPTDAT,APPTSTRT,APPTEND,AVAIL,SLOTS,DONE,SDI,SDECEND,BADATE,LOOP
+2 SET (CNT,DONE)=0
+3 IF $DATA(RETURN)
SET CNT=$ORDER(RETURN("MissionActAvailability",9999),-1)+1
+4 SET CLIN=""
FOR
SET CLIN=$ORDER(@CLINLIST@(CLIN),-1)
if 'CLIN!(DONE)
QUIT
Begin DoDot:1
+5 SET GLOB=$NAME(^TMP("SDESMISSIONAVL",$JOB,CLIN))
KILL @GLOB
+6 SET BADATE=0
+7 SET SDI=$$FMADD^XLFDT(START,-1)
SET SDECEND=END
+8 ;
FOR
SET SDI=$$FMADD^XLFDT(SDI,1)
if SDI>$PIECE(SDECEND,".",1)!(BADATE>0)!(DONE)
QUIT
Begin DoDot:2
+9 IF SDI<0
SET BADATE=1
QUIT
+10 IF ($ORDER(^SC(CLIN,"T",0))="")!($ORDER(^SC(CLIN,"T",0))>SDI)
QUIT
+11 ;do not schedule on holidays
IF $$GET1^DIQ(44,CLIN_",",1918.5,"I")'="Y"
IF $DATA(^HOLIDAY("B",SDI))
QUIT
+12 ;don't get availability if clinic inactive on day SDI
if $$INACTIVE^SDESUTIL(CLIN,$PIECE(SDI,".",1))
QUIT
+13 DO RESAB^SDEC57(GLOB,CLIN,SDI,SDI_"."_2359)
if '$DATA(^TMP("SDESMISSIONAVL",$JOB,CLIN))
QUIT
+14 SET LOOP=0
FOR
SET LOOP=$ORDER(^TMP("SDESMISSIONAVL",$JOB,CLIN,LOOP))
if 'LOOP!(DONE)
QUIT
Begin DoDot:3
+15 SET APPTDAT=$GET(^TMP("SDESMISSIONAVL",$JOB,CLIN,LOOP))
+16 SET APPTSTRT=$PIECE(APPTDAT,U,2)
+17 if APPTSTRT<$$NOW^XLFDT
QUIT
+18 SET APPTEND=$PIECE(APPTDAT,U,3)
+19 SET SLOTS=$PIECE(APPTDAT,U,4)
+20 if SLOTS=0!(SLOTS="")
QUIT
+21 SET AVAIL=$PIECE(APPTDAT,U,5)
+22 SET SLOTS=$SELECT(SLOTS=" ":"",1:SLOTS)
+23 SET SLOTS=$SELECT(AVAIL=2:"",AVAIL=3:"X",1:SLOTS)
+24 IF "jklmnopqrstuvwxyz"[SLOTS
SET SLOTS=9+($FIND("jklmnopqrstuvwxyz",SLOTS)-1)
+25 if 'SLOTS
QUIT
+26 SET CNT=CNT+1
+27 IF NUMBER-SLOTS<0
SET SLOTS=NUMBER
+28 SET NUMBER=$GET(NUMBER)-SLOTS
+29 SET RETURN("MissionActAvailability",CNT,"ClinicID")=CLIN
+30 SET RETURN("MissionActAvailability",CNT,"ClinicName")=$$GET1^DIQ(44,CLIN,.01,"E")
+31 SET RETURN("MissionActAvailability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT($PIECE(APPTDAT,U,2))
+32 SET RETURN("MissionActAvailability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT($PIECE(APPTDAT,U,3))
+33 SET RETURN("MissionActAvailability",CNT,"AvailableSlots")=SLOTS
+34 IF NUMBER<1
SET DONE=1
End DoDot:3
+35 KILL @GLOB
End DoDot:2
End DoDot:1
+36 QUIT
+37 ;
GETMSNELG(ELGARRAY,REQDATE,REQENDDT,PIDDATE,SDAPPTAVAIL,APPTDATE,SDCLNIEN) ; GET Eligibility
+1 NEW HASDATA,SDSTOPCD,CRSTCODEIEN
+2 SET ELGARRAY("MissionEligibility","Code")="0"
+3 SET ELGARRAY("MissionEligibility","Message")="Not Eligible-"_$SELECT(SDSERVICE="M":"Primary Care or Mental Health",1:"Special Care")
+4 ;Stop code ien
SET SDSTOPCD=$$GET1^DIQ(44,SDCLNIEN,8,"I")
+5 SET CRSTCODEIEN=$$GET1^DIQ(44,SDCLNIEN,2503,"I")
+6 SET ELGARRAY("MissionEligibility","PrimaryStopCodeName")=$$GET1^DIQ(40.7,SDSTOPCD,.01,"E")
+7 SET ELGARRAY("MissionEligibility","PrimaryStopCodeAmis")=$$GET1^DIQ(40.7,SDSTOPCD,1,"E")
+8 SET ELGARRAY("MissionEligibility","SecondaryStopCodeName")=$$GET1^DIQ(40.7,CRSTCODEIEN,.01,"E")
+9 SET ELGARRAY("MissionEligibility","SecondaryStopCodeAmis")=$$GET1^DIQ(40.7,CRSTCODEIEN,1,"E")
+10 IF APPTDATE>REQENDDT
Begin DoDot:1
+11 IF (SDAPPTAVAIL="")
Begin DoDot:2
+12 IF ((PIDDATE>=REQDATE)&(PIDDATE<=REQENDDT))
Begin DoDot:3
+13 SET ELGARRAY("MissionEligibility","Code")="1"
+14 SET ELGARRAY("MissionEligibility","Message")="Eligible-"_$SELECT(SDSERVICE="M":"Primary Care or Mental Health",1:"Special Care")
End DoDot:3
End DoDot:2
End DoDot:1
+15 SET HASDATA=($DATA(ELGARRAY)>1)
+16 QUIT HASDATA
+17 ;
BUILDJSON(JSONRETURN,INPUT) ; Build JSON format
+1 SET JSONERROR=""
+2 DO ENCODE^XLFJSON("INPUT","JSONRETURN","JSONERROR")
+3 QUIT
+4 ;
CLEANUP ; Cleanup
+1 KILL HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,REQENDDT,SDAPPTAVAIL,SDSTOPCD,SDTMPARY
+2 KILL ERRORFLAG
+3 KILL HASDATA
+4 KILL JSONERROR
+5 QUIT
SETMISSIONELIG(APPTIEN) ;
+1 NEW REQPTR,REQFILE,REQIEN,PIDDATE,APPTDATE,ELGRETURN,APPTREQTYPE,ELIG,ELGRETURN,CLINIC,MISSIONELIG,RESOURCE,FDA
+2 if '$GET(APPTIEN)
QUIT
+3 SET APPTDATE=$PIECE($$GET1^DIQ(409.84,APPTIEN,.01,"I"),".")
+4 SET RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
+5 SET CLINIC=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
+6 SET APPTDATE=$$FMTISO^SDAMUTDT(APPTDATE,CLINIC)
+7 SET REQPTR=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
+8 SET REQIEN=$PIECE(REQPTR,";")
+9 SET REQFILE=$PIECE(REQPTR,";",2)
+10 IF REQFILE[409.85
Begin DoDot:1
+11 SET APPTREQTYPE=$$GET1^DIQ(409.85,REQIEN,4,"I")
+12 SET PIDDATE=$$GET1^DIQ(409.85,REQIEN,22,"I")
End DoDot:1
+13 IF REQFILE[123
Begin DoDot:1
+14 SET APPTREQTYPE=$$UP^XLFSTR($$GET1^DIQ(123,REQIEN,13,"E"))
+15 SET PIDDATE=$$GET1^DIQ(123,REQIEN,17,"I")
End DoDot:1
+16 IF REQFILE[403.5
Begin DoDot:1
+17 SET APPTREQTYPE="PTCSCH"
+18 SET PIDDATE=$$GET1^DIQ(403.5,REQIEN,5.5,"I")
+19 IF 'PIDDATE
SET PIDDATE=$$GET1^DIQ(403.5,REQIEN,5,"I")
End DoDot:1
+20 SET PIDDATE=$$FMTISO^SDAMUTDT(PIDDATE,CLINIC)
+21 DO GETMISSIONELG^SDESMISSIONELG(.ELGRETURN,REQIEN,PIDDATE,APPTREQTYPE,$GET(SDEAS),APPTDATE,CLINIC)
+22 DO DECODE^XLFJSON("ELGRETURN","MISSIONELIG")
+23 SET ELIG=$GET(MISSIONELIG("MissionEligibility","Code"))
+24 IF ELIG
SET FDA(409.84,APPTIEN_",",2.1)=ELIG
DO FILE^DIE(,"FDA","ERR")
KILL FDA
+25 QUIT
