SDES2QRYAPREQS ;ALB/BWF,AGW,LAB,JAS - QUERY APPOINTMENT REQUESTS; MAR 02,2026
;;5.3;Scheduling;**869,873,875,877,895,927,909,931**;Aug 13, 1993;Build 2
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to DUZ^XUP is supported by IA #7487
;
Q
; SDCONTEXT
;
;S SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37 (required)
;S SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
;S SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
;S SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
;S SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
;
; SDINPUT
;S SDINPUT("FILTER","PATIENT",PATIENT IEN)="" <- for searching by patient
;S SDINPUT("FILTER","REQUEST TYPE","APPT")="" <- for APPT
;S SDINPUT("FILTER","REQUEST TYPE","CONSULT")="" <- for CONSULT
;S SDINPUT("FILTER","REQUEST TYPE","RECALL")="" <- for RECALL
;S SDINPUT("FILTER","REQUEST TYPE","ALL")="" <- for ALL request types
;S SDINPUT("FILTER","REQUEST SUBTYPE","APPT")="" <- for APPT requests
;S SDINPUT("FILTER","REQUEST SUBTYPE","RTC")="" <- for RTC requests
;S SDINPUT("FILTER","REQUEST SUBTYPE","VETERAN")="" <- for VETERAN requests
;S SDINPUT("FILTER","REQUEST SUBTYPE","ALL")="" <- for ALL request sub-types (default)
;S SDINPUT("FILTER","CLINIC",CLINIC IEN)=""
;S SDINPUT("FILTER","SERVICE",AMIS STOP CODE)=""
;S SDINPUT("FILTER","PRIORITY GROUP","GROUP 0")="" <- for group 0
; ,"GROUP 1")="" <- for group 1
; ,"GROUP 2")="" <- for group 2
; ,"GROUP 3")="" <- for group 3
; ,"GROUP 4")="" <- for group 4
; ,"GROUP 5")="" <- for group 5
; ,"GROUP 6")="" <- for group 6
; ,"GROUP 7")="" <- for group 7
; ,"GROUP 8")="" <- for group 8
; ,"ALL")="" <- for ALL groups
;S SDINPUT("FILTER","WAIT TIME")=WAIT TIME
; ALL - for all days
; <30 - less than 30 days
; 30-60 - 30 to 60 days
; 60-90 - 60 to 90 days
; >=90 - greater than/equal to 90 days
;S SDINPUT("FILTER","ORIGINATION DATE")=ORIGINATION DATE
;S SDINPUT("FILTER","PID")=PATIENT INDICATED DATE - ALSO DESIRED DATE
;S SDINPUT("FILTER","URGENCY")=URGENCY IEN (POINTER TO THE PROTOCOL FILE #101) - only applies to consults
;
;S SDINPUT("SORT")=SORT TYPE
; DEFAULT, PATIENT NAME, CLINIC, REQUEST, WAIT TIME, PRIORITY GROUP, ORIGINATION DATE
; PID DATE, SERVICE RELATED, SCVISIT
;
;S SDINPUT("MAX NUMBER OF RECORDS")=MAX NUMBER OF TOTAL RECORDS to accumulate for each request type (optional - max/default 201)
;S SDINPUT("RETURN NUMBER OF RECORDS")=NUMBER OF RECORDS RETURNED WITH EACH CALL (optional - max 201/default 50)
;S SDINPUT("LAST RECORD")=LAST RECORD IEN RETURNED ON THE PREVIOUS CALL (optional)
; - This is used to get the next batch of records up to the value of 'RETURN NUMBER OF RECORDS'
;S SDINPUT("IDEMPOTENCY KEY")=This unique key value will be created upon the initial RPC call that creates the dataset based on the query and will
; be passed back in the return object. It should only be sent in as an input parameter for subsequent RPC calls to receive
; additional records from the initial dataset. (optional, unless LAST RECORD is used)
;
QUERY(JSONRETURN,SDCONTEXT,SDINPUT) ;
N ERRORS,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,REQUESTS,NEWLASTREC,TOTALRECORDS,LASTREC,AMISLIST,IDPKEY,RECORDER,SCPERCENT
S JSONRETURN=$NA(^TMP("SDES2QUERY",$J,"JSON")) K @JSONRETURN
;
; validate context
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("QueryResults",1)="" D ENCODE^XLFJSON("ERRORS",.JSONRETURN) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
;
; set Idempotency Key variable if passed in, if not create a new key for the new dataset
S IDPKEY=$S($D(SDINPUT("IDEMPOTENCY KEY")):SDINPUT("IDEMPOTENCY KEY"),1:"SDES2QUERY_"_DUZ_"_"_$$NOW^XLFDT)
I '$D(^XTMP(IDPKEY,0)) S ^XTMP(IDPKEY,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"A DATASET CREATED WITH SDES2 QUERY APPT REQUESTS BY USER "_DUZ
;
D VALIDATE(.ERRORS,.SDINPUT,.FLTRORIGDATE,.FLTRPIDDATE,.STARTDT,.ENDDT,.AMISLIST)
I $D(ERRORS) S ERRORS("QueryResults",1)="" D ENCODE^XLFJSON("ERRORS",.JSONRETURN) Q
;
; get the next set of records
I $D(SDINPUT("LAST RECORD")) D Q
.I $G(SDINPUT("LAST RECORD"))>($G(^XTMP(IDPKEY,"COUNT"))-1) D Q
..D ERRLOG^SDES2JSON(.ERRORS,52,"No more records in list.")
..S ERRORS("QueryResults",1)=""
..D ENCODE^XLFJSON("ERRORS",.JSONRETURN)
.S NEWLASTREC=$$BUILDBYLASTREC($G(SDINPUT("LAST RECORD")),$G(SDINPUT("RETURN NUMBER OF RECORDS")),.REQUESTS)
.I '$D(REQUESTS) D Q
..S REQUESTS("QueryResults",1)="" D ENCODE^XLFJSON("REQUESTS",.JSONRETURN) Q
.S REQUESTS("QueryResults","LastRecord")=$G(NEWLASTREC)
.S REQUESTS("QueryResults","TotalRecords")=$G(^XTMP(IDPKEY,"COUNT"))
.S REQUESTS("QueryResults","IdempotencyKey")=IDPKEY
.D ENCODE^XLFJSON("REQUESTS",.JSONRETURN)
;
; find by patient
I $D(SDINPUT("FILTER","PATIENT")) D Q
.D FINDBYPAT(.ERRORS,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT)
.S TOTALRECORDS=$$BUILDXREF($G(SDINPUT("SORT")))
.S LASTREC=$$BUILDRESULTS($G(SDINPUT("RETURN NUMBER OF RECORDS")),.REQUESTS)
.I '$D(REQUESTS) D
..S REQUESTS("QueryResults","TotalRecords")=""
..S REQUESTS("QueryResults","LastRecord")=""
..S REQUESTS("QueryResults","IdempotencyKey")=""
.S REQUESTS("QueryResults","TotalRecords")=$G(TOTALRECORDS)
.S REQUESTS("QueryResults","LastRecord")=$G(LASTREC)
.S REQUESTS("QueryResults","IdempotencyKey")=IDPKEY
.D ENCODE^XLFJSON("REQUESTS",.JSONRETURN)
;
; find by request type
I $D(SDINPUT("FILTER","REQUEST TYPE")) D Q
.D FINDBYREQ^SDES2QRYAPREQSA(.ERRORS,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,IDPKEY)
.S TOTALRECORDS=$$BUILDXREF($G(SDINPUT("SORT")))
.S LASTREC=$$BUILDRESULTS($G(SDINPUT("RETURN NUMBER OF RECORDS")),.REQUESTS)
.I '$D(REQUESTS) D
..S REQUESTS("QueryResults","TotalRecords")=""
..S REQUESTS("QueryResults","LastRecord")=""
..S REQUESTS("QueryResults","IdempotencyKey")=""
.S REQUESTS("QueryResults","TotalRecords")=$G(TOTALRECORDS)
.S REQUESTS("QueryResults","LastRecord")=$G(LASTREC)
.S REQUESTS("QueryResults","IdempotencyKey")=IDPKEY
.D ENCODE^XLFJSON("REQUESTS",.JSONRETURN)
Q
VALIDATE(ERRORS,SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,AMISLIST) ;
N NUMRECORDS,VPAT,VRET,VCLIN,VAMIS,STRTENDDATES,NUMRECORDS,RETURNRECORDCNT,VALSTAT,STOPCODEIEN,STOPCODETYPE,STOPCODELIST
S (FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT)=""
S VPAT=0 F S VPAT=$O(SDINPUT("FILTER","PATIENT",VPAT)) Q:'VPAT D
.D VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,2,VPAT,1,,1,2)
; validate request type
D VALREQTYPE(.ERRORS,.SDINPUT)
; validate request sub-type
D VALREQSUBTYPE(.ERRORS,.SDINPUT)
; validate clinic/clinic list
S VCLIN=0 F S VCLIN=$O(SDINPUT("FILTER","CLINIC",VCLIN)) Q:'VCLIN D
.D VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,44,VCLIN,1,,18,19)
; validate services/AMIS stop codes
S VAMIS=0 F S VAMIS=$O(SDINPUT("FILTER","SERVICE",VAMIS)) Q:'VAMIS D
.S STOPCODEIEN=$$AMISTOSTOPCODE^SDES2UTIL(VAMIS)
.D VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,40.7,STOPCODEIEN,1,,92,93) Q:'VRET
.S STOPCODELIST(STOPCODEIEN)=""
I $D(STOPCODELIST) D
.M AMISLIST=SDINPUT("FILTER","SERVICE")
.K SDINPUT("FILTER","SERVICE")
.M SDINPUT("FILTER","SERVICE")=STOPCODELIST
; validate wait time
I '$D(SDINPUT("FILTER","WAIT TIME")) S SDINPUT("FILTER","WAIT TIME")="ALL"
S STRTENDDATES=$$VALWAITTIME(.ERRORS,$G(SDINPUT("FILTER","WAIT TIME")))
S STARTDT=$P(STRTENDDATES,U)
S ENDDT=$P(STRTENDDATES,U,2)
; priority group
D VALPRIOGROUP(.ERRORS,.SDINPUT)
; origination date
I $D(SDINPUT("FILTER","ORIGINATION DATE")) D
.S FLTRORIGDATE=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$G(SDINPUT("FILTER","ORIGINATION DATE")),,,48,49)
; PID date
I $D(SDINPUT("FILTER","PID")) D
.S FLTRPIDDATE=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$G(SDINPUT("FILTER","PID")),,,,548)
; urgency
I $D(SDINPUT("FILTER","URGENCY")) D VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,101,$G(SDINPUT("FILTER","URGENCY")))
; validate sort - default if needed
I $G(SDINPUT("SORT"))="" S SDINPUT("SORT")="DEFAULT"
D VALSORT(.ERRORS,$G(SDINPUT("SORT")))
; validate number of records
S NUMRECORDS=$G(SDINPUT("MAX NUMBER OF RECORDS"))
I NUMRECORDS D VALNUMBERRNG^SDES2VALUTIL(.VALSTAT,.ERRORS,NUMRECORDS,1,201,,,504)
I NUMRECORDS,'$D(SDINPUT("LAST RECORD")) S SDINPUT("MAX NUMBER OF RECORDS")=NUMRECORDS-1
; default to 200 (will return 201)
I 'NUMRECORDS S SDINPUT("MAX NUMBER OF RECORDS")=200
; number of records to return, default to 50
S RETURNRECORDCNT=$G(SDINPUT("RETURN NUMBER OF RECORDS"))
I RETURNRECORDCNT D VALNUMBERRNG^SDES2VALUTIL(.VALSTAT,.ERRORS,RETURNRECORDCNT,1,201,,,504)
I 'RETURNRECORDCNT S SDINPUT("RETURN NUMBER OF RECORDS")=50
Q
FINDBYPAT(ERRORS,SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT) ;
; get consults for this patient
N CONSIEN,PATIENT,CONSTAT,COUNT,DFN,PCE,PRIORITYGROUP,REQIEN,CONSTART,CONEND,INVDTTM,CURRENTENR,ENRRET,PATSCPERCENT,PATSVCCONN,REQCNT
N GMRSERVICE,INVSTART,SERVICE,STAT,OSPEND,OSACT,RECALLIEN,SERVICELIST,GMRSVC
S COUNT=0
S REQCNT=0
S DFN=0 F S DFN=$O(SDINPUT("FILTER","PATIENT",DFN)) Q:'DFN D
.; this line replaces all of the above logic - request SCHEDULING be added to ICR 3812
.D GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
.I $D(SDINPUT("FILTER","PRIORITY GROUP")),('$D(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$D(SDINPUT("FILTER","PRIORITY GROUP","ALL"))) Q
.;
.; appointment requests
.I $D(SDINPUT("FILTER","REQUEST TYPE","APPT"))!($D(SDINPUT("FILTER","REQUEST TYPE","ALL"))) D
..Q:$D(SDINPUT("FILTER","URGENCY"))
..S REQIEN=0 F S REQIEN=$O(^SDEC(409.85,"B",DFN,REQIEN)) Q:'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
...Q:$$GET1^DIQ(409.85,REQIEN,23,"I")="C"
...D FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT,IDPKEY)
.;
.; consults
.I $D(SDINPUT("FILTER","REQUEST TYPE","CONSULT"))!($D(SDINPUT("FILTER","REQUEST TYPE","ALL"))) D
..; by service
..I $D(SDINPUT("FILTER","SERVICE")) D Q
...S SERVICE=0 F S SERVICE=$O(SDINPUT("FILTER","SERVICE",SERVICE)) Q:'SERVICE D
....S SERVICELIST(SERVICE)=SERVICE
...D GETSVC^SDES2QRYAPREQSA(.GMRSVC,.SERVICELIST)
...S OSACT=$O(^ORD(100.01,"B","ACTIVE",0))
...S OSPEND=$O(^ORD(100.01,"B","PENDING",0))
...S GMRSERVICE=0 F S GMRSERVICE=$O(GMRSVC(GMRSERVICE)) Q:'GMRSERVICE D
....F STAT=OSACT,OSPEND Q:REQCNT>SDINPUT("MAX NUMBER OF RECORDS") D
.....Q:STAT=""
.....S INVSTART=9999999-ENDDT-1
.....F S INVSTART=$O(^GMR(123,"AE",GMRSERVICE,STAT,INVSTART)) Q:'INVSTART!($P(INVSTART,".")>(9999999-STARTDT))!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
......S CONSIEN=0 F S CONSIEN=$O(^GMR(123,"AE",GMRSERVICE,STAT,INVSTART,CONSIEN)) Q:'CONSIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
.......Q:$$GET1^DIQ(123,CONSIEN,.02,"I")'=DFN
.......Q:$$REQCHK^SDES2QRYAPREQSA(CONSIEN)
.......D GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
.......D FLTRCONSULT^SDES2QRYAPREQSB(CONSIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT,IDPKEY)
..; by date/time
..S CONSTART=9999999-STARTDT,CONEND=9999999-ENDDT
..S INVDTTM=CONEND
..F S INVDTTM=$O(^GMR(123,"AD",DFN,INVDTTM)) Q:'INVDTTM!(INVDTTM>CONSTART)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
...S CONSIEN=0
...F S CONSIEN=$O(^GMR(123,"AD",DFN,INVDTTM,CONSIEN)) Q:'CONSIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
....Q:$$REQCHK^SDES2QRYAPREQSA(CONSIEN)
....D FLTRCONSULT^SDES2QRYAPREQSB(CONSIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT,IDPKEY)
.;
.; recalls
.I $D(SDINPUT("FILTER","REQUEST TYPE","RECALL"))!($D(SDINPUT("FILTER","REQUEST TYPE","ALL"))) D
..Q:$D(SDINPUT("FILTER","URGENCY"))
..S RECALLIEN=0 F S RECALLIEN=$O(^SD(403.5,"B",DFN,RECALLIEN)) Q:'RECALLIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
...D FLTRRECALL^SDES2QRYAPREQSB(RECALLIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT,IDPKEY)
Q
BUILDXREF(SORT) ;
N SORTBY,REQIEN,DESDATE,ORIGDT,REQTYPE,COUNT,PRIOGRP,SERVICEREL
S RECORDER=0
I SORT="DEFAULT"!(SORT="PRIORITY GROUP") D Q RECORDER
.S PRIOGRP="" F S PRIOGRP=$O(^XTMP(IDPKEY,"DATA",PRIOGRP)) Q:PRIOGRP="" D
..S SERVICEREL="" F S SERVICEREL=$O(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL)) Q:SERVICEREL="" D
...S DESDATE="" F S DESDATE=$O(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL,DESDATE)) Q:DESDATE="" D
....S ORIGDT="" F S ORIGDT=$O(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL,DESDATE,ORIGDT)) Q:ORIGDT="" D
.....S REQIEN=0 F S REQIEN=$O(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL,DESDATE,ORIGDT,REQIEN)) Q:'REQIEN D
......S REQTYPE=$G(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL,DESDATE,ORIGDT,REQIEN))
......S RECORDER=RECORDER+1
......S ^XTMP(IDPKEY,"XREF",RECORDER,REQIEN)=REQTYPE
S SORTBY="" F S SORTBY=$O(^XTMP(IDPKEY,"DATA",SORTBY)) Q:SORTBY="" D
.S REQIEN="" F S REQIEN=$O(^XTMP(IDPKEY,"DATA",SORTBY,REQIEN)) Q:REQIEN="" D
..S REQTYPE=$G(^XTMP(IDPKEY,"DATA",SORTBY,REQIEN))
..S RECORDER=RECORDER+1
..S ^XTMP(IDPKEY,"XREF",RECORDER,REQIEN)=REQTYPE
Q RECORDER
;
BUILDRESULTS(RETURNNUMREC,REQUESTS) ;
N LASTREC,RECORDER,REQIEN,REQTYPE,DFN
S LASTREC=""
S RECORDER=0 F S RECORDER=$O(^XTMP(IDPKEY,"XREF",RECORDER)) Q:'RECORDER!(RECORDER>RETURNNUMREC) D
.S REQIEN=0 F S REQIEN=$O(^XTMP(IDPKEY,"XREF",RECORDER,REQIEN)) Q:'REQIEN!(RECORDER>RETURNNUMREC) D
..S REQTYPE=$G(^XTMP(IDPKEY,"XREF",RECORDER,REQIEN)) Q:REQTYPE=""
..S LASTREC=RECORDER
..I REQTYPE="A" D GETREQUEST^SDES2GETAPPTREQ(.REQUESTS,REQIEN)
..I REQTYPE="C" D GETCONSULT^SDES2GETCONSULTS(.REQUESTS,REQIEN)
..I REQTYPE="R" S DFN=$$GET1^DIQ(403.5,REQIEN,.01,"I") D GETRECALL^SDES2GETRECALL(.REQUESTS,REQIEN,DFN)
Q LASTREC
;
BUILDBYLASTREC(LASTRECORD,NUMRECORDS,REQUESTS) ;
N RECORDER,COUNT,REQTYPE,REQIEN,NEWLASTRECORD,DFN
S COUNT=0,NEWLASTRECORD=""
S RECORDER=LASTRECORD
F S RECORDER=$O(^XTMP(IDPKEY,"XREF",RECORDER)) Q:'RECORDER!(COUNT=NUMRECORDS) D
.S REQIEN=$O(^XTMP(IDPKEY,"XREF",RECORDER,0)) Q:'REQIEN
.S REQTYPE=$G(^XTMP(IDPKEY,"XREF",RECORDER,REQIEN))
.I REQTYPE="A" D GETREQUEST^SDES2GETAPPTREQ(.REQUESTS,REQIEN)
.I REQTYPE="C" D GETCONSULT^SDES2GETCONSULTS(.REQUESTS,REQIEN)
.I REQTYPE="R" S DFN=$$GET1^DIQ(403.5,REQIEN,.01,"I") D GETRECALL^SDES2GETRECALL(.REQUESTS,REQIEN,DFN)
.S NEWLASTRECORD=RECORDER
.S COUNT=COUNT+1
Q NEWLASTRECORD
VALREQTYPE(ERRORS,SDINPUT) ;
N TYPE
; default request type to all
I '$D(SDINPUT("FILTER","REQUEST TYPE")) S SDINPUT("FILTER","REQUEST TYPE","ALL")="" Q
; check for invalid request types
S TYPE="" F S TYPE=$O(SDINPUT("FILTER","REQUEST TYPE",TYPE)) Q:TYPE="" D
.I "CONSULT^RECALL^APPT^ALL"'[TYPE D ERRLOG^SDES2JSON(.ERRORS,61)
Q
VALREQSUBTYPE(ERRORS,SDINPUT) ;
N TYPE
; default request type to all
I '$D(SDINPUT("FILTER","REQUEST SUBTYPE")) S SDINPUT("FILTER","REQUEST SUBTYPE","ALL")="" Q
; check for invalid request types
S TYPE="" F S TYPE=$O(SDINPUT("FILTER","REQUEST SUBTYPE",TYPE)) Q:TYPE="" D
.I "^APPT^RTC^VETERAN^ALL"'[TYPE D ERRLOG^SDES2JSON(.ERRORS,559)
Q
VALWAITTIME(ERRORS,WAITTIME) ;
N SDBEG,SDEND
I WAITTIME'="","<30^30-60^60-90^>=90^ALL"'[WAITTIME D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid wait time.") Q ""
S SDBEG=$S(WAITTIME["ALL":"",WAITTIME="<30":"29",WAITTIME="30-60":"60",WAITTIME="60-90":"90",WAITTIME=">=90":"",1:"")
S SDEND=$S(WAITTIME["ALL":"",WAITTIME="<30":"DT",WAITTIME="30-60":"30",WAITTIME="60-90":"60",WAITTIME=">=90":"90",1:"90")
I SDBEG'="" S SDBEG=$$FMADD^XLFDT(DT,-SDBEG)
I SDBEG="" S SDBEG=1410102
I SDEND'="" S SDEND=$$FMADD^XLFDT(DT,-SDEND)
I SDEND="" S SDEND=4141015
Q SDBEG_U_SDEND
;
VALPRIOGROUP(ERRORS,SDINPUT) ;
N PGROUP,GRP
S PGROUP="" F S PGROUP=$O(SDINPUT("FILTER","PRIORITY GROUP",PGROUP)) Q:PGROUP="" D
.I PGROUP="ALL" D Q
..F GRP=0:1:8 S SDINPUT("FILTER","PRIORITY GROUP",GRP)=""
.I PGROUP="GROUP 0" S SDINPUT("FILTER","PRIORITY GROUP",0)="" Q
.D VALFIELD^SDES2VALUTIL(.VRET,.ERRORS,409.85,10.5,PGROUP) Q:'VRET
.S SDINPUT("FILTER","PRIORITY GROUP",$G(VRET(409.85,10.5,"I")))=""
Q
;
VALSORT(ERRORS,SORT) ;
I "DEFAULT^PATIENT NAME^CLINIC^REQUEST^WAIT TIME^PRIORITY GROUP^ORIGINATION DATE^PID DATE^SERVICE RELATED^SCVISIT"'[$G(SORT) D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid sort criteria.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2QRYAPREQS 17383 printed Apr 22, 2026@14:52:13 Page 2
SDES2QRYAPREQS ;ALB/BWF,AGW,LAB,JAS - QUERY APPOINTMENT REQUESTS; MAR 02,2026
+1 ;;5.3;Scheduling;**869,873,875,877,895,927,909,931**;Aug 13, 1993;Build 2
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to DUZ^XUP is supported by IA #7487
+5 ;
+6 QUIT
+7 ; SDCONTEXT
+8 ;
+9 ;S SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37 (required)
+10 ;S SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
+11 ;S SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
+12 ;S SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
+13 ;S SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
+14 ;
+15 ; SDINPUT
+16 ;S SDINPUT("FILTER","PATIENT",PATIENT IEN)="" <- for searching by patient
+17 ;S SDINPUT("FILTER","REQUEST TYPE","APPT")="" <- for APPT
+18 ;S SDINPUT("FILTER","REQUEST TYPE","CONSULT")="" <- for CONSULT
+19 ;S SDINPUT("FILTER","REQUEST TYPE","RECALL")="" <- for RECALL
+20 ;S SDINPUT("FILTER","REQUEST TYPE","ALL")="" <- for ALL request types
+21 ;S SDINPUT("FILTER","REQUEST SUBTYPE","APPT")="" <- for APPT requests
+22 ;S SDINPUT("FILTER","REQUEST SUBTYPE","RTC")="" <- for RTC requests
+23 ;S SDINPUT("FILTER","REQUEST SUBTYPE","VETERAN")="" <- for VETERAN requests
+24 ;S SDINPUT("FILTER","REQUEST SUBTYPE","ALL")="" <- for ALL request sub-types (default)
+25 ;S SDINPUT("FILTER","CLINIC",CLINIC IEN)=""
+26 ;S SDINPUT("FILTER","SERVICE",AMIS STOP CODE)=""
+27 ;S SDINPUT("FILTER","PRIORITY GROUP","GROUP 0")="" <- for group 0
+28 ; ,"GROUP 1")="" <- for group 1
+29 ; ,"GROUP 2")="" <- for group 2
+30 ; ,"GROUP 3")="" <- for group 3
+31 ; ,"GROUP 4")="" <- for group 4
+32 ; ,"GROUP 5")="" <- for group 5
+33 ; ,"GROUP 6")="" <- for group 6
+34 ; ,"GROUP 7")="" <- for group 7
+35 ; ,"GROUP 8")="" <- for group 8
+36 ; ,"ALL")="" <- for ALL groups
+37 ;S SDINPUT("FILTER","WAIT TIME")=WAIT TIME
+38 ; ALL - for all days
+39 ; <30 - less than 30 days
+40 ; 30-60 - 30 to 60 days
+41 ; 60-90 - 60 to 90 days
+42 ; >=90 - greater than/equal to 90 days
+43 ;S SDINPUT("FILTER","ORIGINATION DATE")=ORIGINATION DATE
+44 ;S SDINPUT("FILTER","PID")=PATIENT INDICATED DATE - ALSO DESIRED DATE
+45 ;S SDINPUT("FILTER","URGENCY")=URGENCY IEN (POINTER TO THE PROTOCOL FILE #101) - only applies to consults
+46 ;
+47 ;S SDINPUT("SORT")=SORT TYPE
+48 ; DEFAULT, PATIENT NAME, CLINIC, REQUEST, WAIT TIME, PRIORITY GROUP, ORIGINATION DATE
+49 ; PID DATE, SERVICE RELATED, SCVISIT
+50 ;
+51 ;S SDINPUT("MAX NUMBER OF RECORDS")=MAX NUMBER OF TOTAL RECORDS to accumulate for each request type (optional - max/default 201)
+52 ;S SDINPUT("RETURN NUMBER OF RECORDS")=NUMBER OF RECORDS RETURNED WITH EACH CALL (optional - max 201/default 50)
+53 ;S SDINPUT("LAST RECORD")=LAST RECORD IEN RETURNED ON THE PREVIOUS CALL (optional)
+54 ; - This is used to get the next batch of records up to the value of 'RETURN NUMBER OF RECORDS'
+55 ;S SDINPUT("IDEMPOTENCY KEY")=This unique key value will be created upon the initial RPC call that creates the dataset based on the query and will
+56 ; be passed back in the return object. It should only be sent in as an input parameter for subsequent RPC calls to receive
+57 ; additional records from the initial dataset. (optional, unless LAST RECORD is used)
+58 ;
QUERY(JSONRETURN,SDCONTEXT,SDINPUT) ;
+1 NEW ERRORS,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,REQUESTS,NEWLASTREC,TOTALRECORDS,LASTREC,AMISLIST,IDPKEY,RECORDER,SCPERCENT
+2 SET JSONRETURN=$NAME(^TMP("SDES2QUERY",$JOB,"JSON"))
KILL @JSONRETURN
+3 ;
+4 ; validate context
+5 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+6 IF $DATA(ERRORS)
SET ERRORS("QueryResults",1)=""
DO ENCODE^XLFJSON("ERRORS",.JSONRETURN)
QUIT
+7 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+8 ;
+9 ; set Idempotency Key variable if passed in, if not create a new key for the new dataset
+10 SET IDPKEY=$SELECT($DATA(SDINPUT("IDEMPOTENCY KEY")):SDINPUT("IDEMPOTENCY KEY"),1:"SDES2QUERY_"_DUZ_"_"_$$NOW^XLFDT)
+11 IF '$DATA(^XTMP(IDPKEY,0))
SET ^XTMP(IDPKEY,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"A DATASET CREATED WITH SDES2 QUERY APPT REQUESTS BY USER "_DUZ
+12 ;
+13 DO VALIDATE(.ERRORS,.SDINPUT,.FLTRORIGDATE,.FLTRPIDDATE,.STARTDT,.ENDDT,.AMISLIST)
+14 IF $DATA(ERRORS)
SET ERRORS("QueryResults",1)=""
DO ENCODE^XLFJSON("ERRORS",.JSONRETURN)
QUIT
+15 ;
+16 ; get the next set of records
+17 IF $DATA(SDINPUT("LAST RECORD"))
Begin DoDot:1
+18 IF $GET(SDINPUT("LAST RECORD"))>($GET(^XTMP(IDPKEY,"COUNT"))-1)
Begin DoDot:2
+19 DO ERRLOG^SDES2JSON(.ERRORS,52,"No more records in list.")
+20 SET ERRORS("QueryResults",1)=""
+21 DO ENCODE^XLFJSON("ERRORS",.JSONRETURN)
End DoDot:2
QUIT
+22 SET NEWLASTREC=$$BUILDBYLASTREC($GET(SDINPUT("LAST RECORD")),$GET(SDINPUT("RETURN NUMBER OF RECORDS")),.REQUESTS)
+23 IF '$DATA(REQUESTS)
Begin DoDot:2
+24 SET REQUESTS("QueryResults",1)=""
DO ENCODE^XLFJSON("REQUESTS",.JSONRETURN)
QUIT
End DoDot:2
QUIT
+25 SET REQUESTS("QueryResults","LastRecord")=$GET(NEWLASTREC)
+26 SET REQUESTS("QueryResults","TotalRecords")=$GET(^XTMP(IDPKEY,"COUNT"))
+27 SET REQUESTS("QueryResults","IdempotencyKey")=IDPKEY
+28 DO ENCODE^XLFJSON("REQUESTS",.JSONRETURN)
End DoDot:1
QUIT
+29 ;
+30 ; find by patient
+31 IF $DATA(SDINPUT("FILTER","PATIENT"))
Begin DoDot:1
+32 DO FINDBYPAT(.ERRORS,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT)
+33 SET TOTALRECORDS=$$BUILDXREF($GET(SDINPUT("SORT")))
+34 SET LASTREC=$$BUILDRESULTS($GET(SDINPUT("RETURN NUMBER OF RECORDS")),.REQUESTS)
+35 IF '$DATA(REQUESTS)
Begin DoDot:2
+36 SET REQUESTS("QueryResults","TotalRecords")=""
+37 SET REQUESTS("QueryResults","LastRecord")=""
+38 SET REQUESTS("QueryResults","IdempotencyKey")=""
End DoDot:2
+39 SET REQUESTS("QueryResults","TotalRecords")=$GET(TOTALRECORDS)
+40 SET REQUESTS("QueryResults","LastRecord")=$GET(LASTREC)
+41 SET REQUESTS("QueryResults","IdempotencyKey")=IDPKEY
+42 DO ENCODE^XLFJSON("REQUESTS",.JSONRETURN)
End DoDot:1
QUIT
+43 ;
+44 ; find by request type
+45 IF $DATA(SDINPUT("FILTER","REQUEST TYPE"))
Begin DoDot:1
+46 DO FINDBYREQ^SDES2QRYAPREQSA(.ERRORS,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,IDPKEY)
+47 SET TOTALRECORDS=$$BUILDXREF($GET(SDINPUT("SORT")))
+48 SET LASTREC=$$BUILDRESULTS($GET(SDINPUT("RETURN NUMBER OF RECORDS")),.REQUESTS)
+49 IF '$DATA(REQUESTS)
Begin DoDot:2
+50 SET REQUESTS("QueryResults","TotalRecords")=""
+51 SET REQUESTS("QueryResults","LastRecord")=""
+52 SET REQUESTS("QueryResults","IdempotencyKey")=""
End DoDot:2
+53 SET REQUESTS("QueryResults","TotalRecords")=$GET(TOTALRECORDS)
+54 SET REQUESTS("QueryResults","LastRecord")=$GET(LASTREC)
+55 SET REQUESTS("QueryResults","IdempotencyKey")=IDPKEY
+56 DO ENCODE^XLFJSON("REQUESTS",.JSONRETURN)
End DoDot:1
QUIT
+57 QUIT
VALIDATE(ERRORS,SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,AMISLIST) ;
+1 NEW NUMRECORDS,VPAT,VRET,VCLIN,VAMIS,STRTENDDATES,NUMRECORDS,RETURNRECORDCNT,VALSTAT,STOPCODEIEN,STOPCODETYPE,STOPCODELIST
+2 SET (FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT)=""
+3 SET VPAT=0
FOR
SET VPAT=$ORDER(SDINPUT("FILTER","PATIENT",VPAT))
if 'VPAT
QUIT
Begin DoDot:1
+4 DO VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,2,VPAT,1,,1,2)
End DoDot:1
+5 ; validate request type
+6 DO VALREQTYPE(.ERRORS,.SDINPUT)
+7 ; validate request sub-type
+8 DO VALREQSUBTYPE(.ERRORS,.SDINPUT)
+9 ; validate clinic/clinic list
+10 SET VCLIN=0
FOR
SET VCLIN=$ORDER(SDINPUT("FILTER","CLINIC",VCLIN))
if 'VCLIN
QUIT
Begin DoDot:1
+11 DO VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,44,VCLIN,1,,18,19)
End DoDot:1
+12 ; validate services/AMIS stop codes
+13 SET VAMIS=0
FOR
SET VAMIS=$ORDER(SDINPUT("FILTER","SERVICE",VAMIS))
if 'VAMIS
QUIT
Begin DoDot:1
+14 SET STOPCODEIEN=$$AMISTOSTOPCODE^SDES2UTIL(VAMIS)
+15 DO VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,40.7,STOPCODEIEN,1,,92,93)
if 'VRET
QUIT
+16 SET STOPCODELIST(STOPCODEIEN)=""
End DoDot:1
+17 IF $DATA(STOPCODELIST)
Begin DoDot:1
+18 MERGE AMISLIST=SDINPUT("FILTER","SERVICE")
+19 KILL SDINPUT("FILTER","SERVICE")
+20 MERGE SDINPUT("FILTER","SERVICE")=STOPCODELIST
End DoDot:1
+21 ; validate wait time
+22 IF '$DATA(SDINPUT("FILTER","WAIT TIME"))
SET SDINPUT("FILTER","WAIT TIME")="ALL"
+23 SET STRTENDDATES=$$VALWAITTIME(.ERRORS,$GET(SDINPUT("FILTER","WAIT TIME")))
+24 SET STARTDT=$PIECE(STRTENDDATES,U)
+25 SET ENDDT=$PIECE(STRTENDDATES,U,2)
+26 ; priority group
+27 DO VALPRIOGROUP(.ERRORS,.SDINPUT)
+28 ; origination date
+29 IF $DATA(SDINPUT("FILTER","ORIGINATION DATE"))
Begin DoDot:1
+30 SET FLTRORIGDATE=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$GET(SDINPUT("FILTER","ORIGINATION DATE")),,,48,49)
End DoDot:1
+31 ; PID date
+32 IF $DATA(SDINPUT("FILTER","PID"))
Begin DoDot:1
+33 SET FLTRPIDDATE=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$GET(SDINPUT("FILTER","PID")),,,,548)
End DoDot:1
+34 ; urgency
+35 IF $DATA(SDINPUT("FILTER","URGENCY"))
DO VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,101,$GET(SDINPUT("FILTER","URGENCY")))
+36 ; validate sort - default if needed
+37 IF $GET(SDINPUT("SORT"))=""
SET SDINPUT("SORT")="DEFAULT"
+38 DO VALSORT(.ERRORS,$GET(SDINPUT("SORT")))
+39 ; validate number of records
+40 SET NUMRECORDS=$GET(SDINPUT("MAX NUMBER OF RECORDS"))
+41 IF NUMRECORDS
DO VALNUMBERRNG^SDES2VALUTIL(.VALSTAT,.ERRORS,NUMRECORDS,1,201,,,504)
+42 IF NUMRECORDS
IF '$DATA(SDINPUT("LAST RECORD"))
SET SDINPUT("MAX NUMBER OF RECORDS")=NUMRECORDS-1
+43 ; default to 200 (will return 201)
+44 IF 'NUMRECORDS
SET SDINPUT("MAX NUMBER OF RECORDS")=200
+45 ; number of records to return, default to 50
+46 SET RETURNRECORDCNT=$GET(SDINPUT("RETURN NUMBER OF RECORDS"))
+47 IF RETURNRECORDCNT
DO VALNUMBERRNG^SDES2VALUTIL(.VALSTAT,.ERRORS,RETURNRECORDCNT,1,201,,,504)
+48 IF 'RETURNRECORDCNT
SET SDINPUT("RETURN NUMBER OF RECORDS")=50
+49 QUIT
FINDBYPAT(ERRORS,SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT) ;
+1 ; get consults for this patient
+2 NEW CONSIEN,PATIENT,CONSTAT,COUNT,DFN,PCE,PRIORITYGROUP,REQIEN,CONSTART,CONEND,INVDTTM,CURRENTENR,ENRRET,PATSCPERCENT,PATSVCCONN,REQCNT
+3 NEW GMRSERVICE,INVSTART,SERVICE,STAT,OSPEND,OSACT,RECALLIEN,SERVICELIST,GMRSVC
+4 SET COUNT=0
+5 SET REQCNT=0
+6 SET DFN=0
FOR
SET DFN=$ORDER(SDINPUT("FILTER","PATIENT",DFN))
if 'DFN
QUIT
Begin DoDot:1
+7 ; this line replaces all of the above logic - request SCHEDULING be added to ICR 3812
+8 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+9 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+10 ;
+11 ; appointment requests
+12 IF $DATA(SDINPUT("FILTER","REQUEST TYPE","APPT"))!($DATA(SDINPUT("FILTER","REQUEST TYPE","ALL")))
Begin DoDot:2
+13 if $DATA(SDINPUT("FILTER","URGENCY"))
QUIT
+14 SET REQIEN=0
FOR
SET REQIEN=$ORDER(^SDEC(409.85,"B",DFN,REQIEN))
if 'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:3
+15 if $$GET1^DIQ(409.85,REQIEN,23,"I")="C"
QUIT
+16 DO FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT,IDPKEY)
End DoDot:3
End DoDot:2
+17 ;
+18 ; consults
+19 IF $DATA(SDINPUT("FILTER","REQUEST TYPE","CONSULT"))!($DATA(SDINPUT("FILTER","REQUEST TYPE","ALL")))
Begin DoDot:2
+20 ; by service
+21 IF $DATA(SDINPUT("FILTER","SERVICE"))
Begin DoDot:3
+22 SET SERVICE=0
FOR
SET SERVICE=$ORDER(SDINPUT("FILTER","SERVICE",SERVICE))
if 'SERVICE
QUIT
Begin DoDot:4
+23 SET SERVICELIST(SERVICE)=SERVICE
End DoDot:4
+24 DO GETSVC^SDES2QRYAPREQSA(.GMRSVC,.SERVICELIST)
+25 SET OSACT=$ORDER(^ORD(100.01,"B","ACTIVE",0))
+26 SET OSPEND=$ORDER(^ORD(100.01,"B","PENDING",0))
+27 SET GMRSERVICE=0
FOR
SET GMRSERVICE=$ORDER(GMRSVC(GMRSERVICE))
if 'GMRSERVICE
QUIT
Begin DoDot:4
+28 FOR STAT=OSACT,OSPEND
if REQCNT>SDINPUT("MAX NUMBER OF RECORDS")
QUIT
Begin DoDot:5
+29 if STAT=""
QUIT
+30 SET INVSTART=9999999-ENDDT-1
+31 FOR
SET INVSTART=$ORDER(^GMR(123,"AE",GMRSERVICE,STAT,INVSTART))
if 'INVSTART!($PIECE(INVSTART,".")>(9999999-STARTDT))!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:6
+32 SET CONSIEN=0
FOR
SET CONSIEN=$ORDER(^GMR(123,"AE",GMRSERVICE,STAT,INVSTART,CONSIEN))
if 'CONSIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:7
+33 if $$GET1^DIQ(123,CONSIEN,.02,"I")'=DFN
QUIT
+34 if $$REQCHK^SDES2QRYAPREQSA(CONSIEN)
QUIT
+35 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+36 DO FLTRCONSULT^SDES2QRYAPREQSB(CONSIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT,IDPKEY)
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
+37 ; by date/time
+38 SET CONSTART=9999999-STARTDT
SET CONEND=9999999-ENDDT
+39 SET INVDTTM=CONEND
+40 FOR
SET INVDTTM=$ORDER(^GMR(123,"AD",DFN,INVDTTM))
if 'INVDTTM!(INVDTTM>CONSTART)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:3
+41 SET CONSIEN=0
+42 FOR
SET CONSIEN=$ORDER(^GMR(123,"AD",DFN,INVDTTM,CONSIEN))
if 'CONSIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:4
+43 if $$REQCHK^SDES2QRYAPREQSA(CONSIEN)
QUIT
+44 DO FLTRCONSULT^SDES2QRYAPREQSB(CONSIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT,IDPKEY)
End DoDot:4
End DoDot:3
End DoDot:2
+45 ;
+46 ; recalls
+47 IF $DATA(SDINPUT("FILTER","REQUEST TYPE","RECALL"))!($DATA(SDINPUT("FILTER","REQUEST TYPE","ALL")))
Begin DoDot:2
+48 if $DATA(SDINPUT("FILTER","URGENCY"))
QUIT
+49 SET RECALLIEN=0
FOR
SET RECALLIEN=$ORDER(^SD(403.5,"B",DFN,RECALLIEN))
if 'RECALLIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:3
+50 DO FLTRRECALL^SDES2QRYAPREQSB(RECALLIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT,IDPKEY)
End DoDot:3
End DoDot:2
End DoDot:1
+51 QUIT
BUILDXREF(SORT) ;
+1 NEW SORTBY,REQIEN,DESDATE,ORIGDT,REQTYPE,COUNT,PRIOGRP,SERVICEREL
+2 SET RECORDER=0
+3 IF SORT="DEFAULT"!(SORT="PRIORITY GROUP")
Begin DoDot:1
+4 SET PRIOGRP=""
FOR
SET PRIOGRP=$ORDER(^XTMP(IDPKEY,"DATA",PRIOGRP))
if PRIOGRP=""
QUIT
Begin DoDot:2
+5 SET SERVICEREL=""
FOR
SET SERVICEREL=$ORDER(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL))
if SERVICEREL=""
QUIT
Begin DoDot:3
+6 SET DESDATE=""
FOR
SET DESDATE=$ORDER(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL,DESDATE))
if DESDATE=""
QUIT
Begin DoDot:4
+7 SET ORIGDT=""
FOR
SET ORIGDT=$ORDER(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL,DESDATE,ORIGDT))
if ORIGDT=""
QUIT
Begin DoDot:5
+8 SET REQIEN=0
FOR
SET REQIEN=$ORDER(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL,DESDATE,ORIGDT,REQIEN))
if 'REQIEN
QUIT
Begin DoDot:6
+9 SET REQTYPE=$GET(^XTMP(IDPKEY,"DATA",PRIOGRP,SERVICEREL,DESDATE,ORIGDT,REQIEN))
+10 SET RECORDER=RECORDER+1
+11 SET ^XTMP(IDPKEY,"XREF",RECORDER,REQIEN)=REQTYPE
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
QUIT RECORDER
+12 SET SORTBY=""
FOR
SET SORTBY=$ORDER(^XTMP(IDPKEY,"DATA",SORTBY))
if SORTBY=""
QUIT
Begin DoDot:1
+13 SET REQIEN=""
FOR
SET REQIEN=$ORDER(^XTMP(IDPKEY,"DATA",SORTBY,REQIEN))
if REQIEN=""
QUIT
Begin DoDot:2
+14 SET REQTYPE=$GET(^XTMP(IDPKEY,"DATA",SORTBY,REQIEN))
+15 SET RECORDER=RECORDER+1
+16 SET ^XTMP(IDPKEY,"XREF",RECORDER,REQIEN)=REQTYPE
End DoDot:2
End DoDot:1
+17 QUIT RECORDER
+18 ;
BUILDRESULTS(RETURNNUMREC,REQUESTS) ;
+1 NEW LASTREC,RECORDER,REQIEN,REQTYPE,DFN
+2 SET LASTREC=""
+3 SET RECORDER=0
FOR
SET RECORDER=$ORDER(^XTMP(IDPKEY,"XREF",RECORDER))
if 'RECORDER!(RECORDER>RETURNNUMREC)
QUIT
Begin DoDot:1
+4 SET REQIEN=0
FOR
SET REQIEN=$ORDER(^XTMP(IDPKEY,"XREF",RECORDER,REQIEN))
if 'REQIEN!(RECORDER>RETURNNUMREC)
QUIT
Begin DoDot:2
+5 SET REQTYPE=$GET(^XTMP(IDPKEY,"XREF",RECORDER,REQIEN))
if REQTYPE=""
QUIT
+6 SET LASTREC=RECORDER
+7 IF REQTYPE="A"
DO GETREQUEST^SDES2GETAPPTREQ(.REQUESTS,REQIEN)
+8 IF REQTYPE="C"
DO GETCONSULT^SDES2GETCONSULTS(.REQUESTS,REQIEN)
+9 IF REQTYPE="R"
SET DFN=$$GET1^DIQ(403.5,REQIEN,.01,"I")
DO GETRECALL^SDES2GETRECALL(.REQUESTS,REQIEN,DFN)
End DoDot:2
End DoDot:1
+10 QUIT LASTREC
+11 ;
BUILDBYLASTREC(LASTRECORD,NUMRECORDS,REQUESTS) ;
+1 NEW RECORDER,COUNT,REQTYPE,REQIEN,NEWLASTRECORD,DFN
+2 SET COUNT=0
SET NEWLASTRECORD=""
+3 SET RECORDER=LASTRECORD
+4 FOR
SET RECORDER=$ORDER(^XTMP(IDPKEY,"XREF",RECORDER))
if 'RECORDER!(COUNT=NUMRECORDS)
QUIT
Begin DoDot:1
+5 SET REQIEN=$ORDER(^XTMP(IDPKEY,"XREF",RECORDER,0))
if 'REQIEN
QUIT
+6 SET REQTYPE=$GET(^XTMP(IDPKEY,"XREF",RECORDER,REQIEN))
+7 IF REQTYPE="A"
DO GETREQUEST^SDES2GETAPPTREQ(.REQUESTS,REQIEN)
+8 IF REQTYPE="C"
DO GETCONSULT^SDES2GETCONSULTS(.REQUESTS,REQIEN)
+9 IF REQTYPE="R"
SET DFN=$$GET1^DIQ(403.5,REQIEN,.01,"I")
DO GETRECALL^SDES2GETRECALL(.REQUESTS,REQIEN,DFN)
+10 SET NEWLASTRECORD=RECORDER
+11 SET COUNT=COUNT+1
End DoDot:1
+12 QUIT NEWLASTRECORD
VALREQTYPE(ERRORS,SDINPUT) ;
+1 NEW TYPE
+2 ; default request type to all
+3 IF '$DATA(SDINPUT("FILTER","REQUEST TYPE"))
SET SDINPUT("FILTER","REQUEST TYPE","ALL")=""
QUIT
+4 ; check for invalid request types
+5 SET TYPE=""
FOR
SET TYPE=$ORDER(SDINPUT("FILTER","REQUEST TYPE",TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+6 IF "CONSULT^RECALL^APPT^ALL"'[TYPE
DO ERRLOG^SDES2JSON(.ERRORS,61)
End DoDot:1
+7 QUIT
VALREQSUBTYPE(ERRORS,SDINPUT) ;
+1 NEW TYPE
+2 ; default request type to all
+3 IF '$DATA(SDINPUT("FILTER","REQUEST SUBTYPE"))
SET SDINPUT("FILTER","REQUEST SUBTYPE","ALL")=""
QUIT
+4 ; check for invalid request types
+5 SET TYPE=""
FOR
SET TYPE=$ORDER(SDINPUT("FILTER","REQUEST SUBTYPE",TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+6 IF "^APPT^RTC^VETERAN^ALL"'[TYPE
DO ERRLOG^SDES2JSON(.ERRORS,559)
End DoDot:1
+7 QUIT
VALWAITTIME(ERRORS,WAITTIME) ;
+1 NEW SDBEG,SDEND
+2 IF WAITTIME'=""
IF "<30^30-60^60-90^>=90^ALL"'[WAITTIME
DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid wait time.")
QUIT ""
+3 SET SDBEG=$SELECT(WAITTIME["ALL":"",WAITTIME="<30":"29",WAITTIME="30-60":"60",WAITTIME="60-90":"90",WAITTIME=">=90":"",1:"")
+4 SET SDEND=$SELECT(WAITTIME["ALL":"",WAITTIME="<30":"DT",WAITTIME="30-60":"30",WAITTIME="60-90":"60",WAITTIME=">=90":"90",1:"90")
+5 IF SDBEG'=""
SET SDBEG=$$FMADD^XLFDT(DT,-SDBEG)
+6 IF SDBEG=""
SET SDBEG=1410102
+7 IF SDEND'=""
SET SDEND=$$FMADD^XLFDT(DT,-SDEND)
+8 IF SDEND=""
SET SDEND=4141015
+9 QUIT SDBEG_U_SDEND
+10 ;
VALPRIOGROUP(ERRORS,SDINPUT) ;
+1 NEW PGROUP,GRP
+2 SET PGROUP=""
FOR
SET PGROUP=$ORDER(SDINPUT("FILTER","PRIORITY GROUP",PGROUP))
if PGROUP=""
QUIT
Begin DoDot:1
+3 IF PGROUP="ALL"
Begin DoDot:2
+4 FOR GRP=0:1:8
SET SDINPUT("FILTER","PRIORITY GROUP",GRP)=""
End DoDot:2
QUIT
+5 IF PGROUP="GROUP 0"
SET SDINPUT("FILTER","PRIORITY GROUP",0)=""
QUIT
+6 DO VALFIELD^SDES2VALUTIL(.VRET,.ERRORS,409.85,10.5,PGROUP)
if 'VRET
QUIT
+7 SET SDINPUT("FILTER","PRIORITY GROUP",$GET(VRET(409.85,10.5,"I")))=""
End DoDot:1
+8 QUIT
+9 ;
VALSORT(ERRORS,SORT) ;
+1 IF "DEFAULT^PATIENT NAME^CLINIC^REQUEST^WAIT TIME^PRIORITY GROUP^ORIGINATION DATE^PID DATE^SERVICE RELATED^SCVISIT"'[$GET(SORT)
DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid sort criteria.")
+2 QUIT
