SDES2QRYAPREQSA ;ALB/BWF - QUERY APPOINTMENT REQUESTS; JAN 4,2023
;;5.3;Scheduling;**869,875,885**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
Q
FINDBYREQ(ERRORS,SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT) ;
N REQCNT,DFN,PRIORITYGROUP,CURRENTENR,PATSVCCONN,PATSCPERCENT,COUNT,REQCNT,CLINIEN,REQIEN,REQDATE,STOPDATE
N PGROUP,CLINIC,FLTRPRIOGROUP,SERVICELIST,STAT,STOPCDATE,CONSIEN,GMRSERVICE,INVSTART,RECALLIEN,SERVICE
S COUNT=0
;
; appointment requests
;
I $D(SDINPUT("FILTER","REQUEST TYPE","APPT"))!($D(SDINPUT("FILTER","REQUEST TYPE","ALL"))) D
.S REQCNT=0
.; by clinic
.I $D(SDINPUT("FILTER","CLINIC")) D
..S CLINIEN=0 F S CLINIEN=$O(SDINPUT("FILTER","CLINIC",CLINIEN)) Q:'CLINIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
...; use GCC when filtering by PID DATE
...I FLTRPIDDATE'="" D Q
....S REQIEN=0 F S REQIEN=$O(^SDEC(409.85,"ECC","O",CLINIEN,FLTRPIDDATE,REQIEN)) Q:'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
.....S DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I") Q:'DFN
.....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
.....D FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
...; use EC when not filtering by PID DATE
...S REQDATE=$S(FLTRORIGDATE:FLTRORIGDATE-.01,1:STARTDT-.01)
...S STOPDATE=$S(FLTRORIGDATE:FLTRORIGDATE_.9999,1:ENDDT)
...F S REQDATE=$O(^SDEC(409.85,"EC","O",CLINIEN,REQDATE)) Q:'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
....S REQIEN=0 F S REQIEN=$O(^SDEC(409.85,"EC","O",CLINIEN,REQDATE,REQIEN)) Q:'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
.....S DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I") Q:'DFN
.....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
.....D FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
.;
.; by service
.I $D(SDINPUT("FILTER","SERVICE")) D
..S SERVICE=0 F S SERVICE=$O(SDINPUT("FILTER","SERVICE",SERVICE)) Q:'SERVICE!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
...;
...; filter by PID date (aka desired date)
...I FLTRPIDDATE D Q
....S REQDATE=FLTRPIDDATE-.01
....S STOPDATE=FLTRPIDDATE_.9999
....F S REQDATE=$O(^SDEC(409.85,"ESC","O",SERVICE,REQDATE)) Q:'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
.....S REQIEN=0 F S REQIEN=$O(^SDEC(409.85,"ESC","O",SERVICE,REQDATE,REQIEN)) Q:'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
......S DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I") Q:'DFN
......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
......D FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
...;
...; filter by enrollment priority
...I $D(SDINPUT("FILTER","PRIORITY GROUP")) D Q
....S REQDATE=STARTDT-.01
....S STOPDATE=ENDDT_.9999
....; all groups
....I $D(SDINPUT("FILTER","PRIORITY GROUP","ALL")) D Q
.....S PGROUP="" F S PGROUP=$O(^SDEC(409.85,"ESP","O",SERVICE,PGROUP)) Q:PGROUP=""!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
......F S REQDATE=$O(^SDEC(409.85,"ESP","O",SERVICE,PGROUP,REQDATE)) Q:'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
.......S REQIEN=0 F S REQIEN=$O(^SDEC(409.85,"ESP","O",SERVICE,PGROUP,REQDATE,REQIEN)) Q:'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
........S DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I") Q:'DFN
........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
........D FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
....; filter by specific groups - start at A to only pick up "GROUP n"
....S FLTRPRIOGROUP="A" F S FLTRPRIOGROUP=$O(SDINPUT("FILTER","PRIORITY GROUP",FLTRPRIOGROUP)) Q:FLTRPRIOGROUP="" D
.....S PGROUP=$P(FLTRPRIOGROUP," ",2)
.....F S REQDATE=$O(^SDEC(409.85,"ESP","O",SERVICE,PGROUP,REQDATE)) Q:'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
......S REQIEN=0 F S REQIEN=$O(^SDEC(409.85,"ESP","O",SERVICE,PGROUP,REQDATE,REQIEN)) Q:'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
.......S DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I") Q:'DFN
.......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
.......D FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
...;
...S REQDATE=STARTDT-.01
...S STOPDATE=ENDDT_.9999
...F S REQDATE=$O(^SDEC(409.85,"ES","O",SERVICE,REQDATE)) Q:'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
....S REQIEN=0 F S REQIEN=$O(^SDEC(409.85,"ES","O",SERVICE,REQDATE,REQIEN)) Q:'REQIEN!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
.....S DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I") Q:'DFN
.....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
.....D FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
;
; consults
I $D(SDINPUT("FILTER","REQUEST TYPE","CONSULT"))!($D(SDINPUT("FILTER","REQUEST TYPE","ALL"))) D
.S REQCNT=0
.; by clinic
.I $D(SDINPUT("FILTER","CLINIC")) D Q
..S CLINIC=0 F S CLINIC=$O(SDINPUT("FILTER","CLINIC",CLINIC)) Q:'CLINIC!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
...S CONSIEN=0 F S CONSIEN=$O(^GMR(123,"H",CLINIC,CONSIEN)) Q:'CONSIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
....Q:$$REQCHK(CONSIEN)
....S DFN=$$GET1^DIQ(123,CONSIEN,.02,"I") Q:'DFN
....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
....D FLTRCONSULT^SDES2QRYAPREQSB(CONSIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
.; 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 GMRSERVICE=0 F S GMRSERVICE=$O(GMRSVC(GMRSERVICE)) Q:'GMRSERVICE D
...S OSACT=$O(^ORD(100.01,"B","ACTIVE",0))
...S OSPEND=$O(^ORD(100.01,"B","PENDING",0))
...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:$$REQCHK(CONSIEN)
......S DFN=$$GET1^DIQ(123,CONSIEN,.02,"I") Q:'DFN
......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
......D FLTRCONSULT^SDES2QRYAPREQSB(CONSIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
;
; recalls
I $D(SDINPUT("FILTER","REQUEST TYPE","RECALL"))!($D(SDINPUT("FILTER","REQUEST TYPE","ALL"))) D
.S REQCNT=0
.I $D(SDINPUT("FILTER","CLINIC")) D Q
..S CLINIC=0 F S CLINIC=$O(SDINPUT("FILTER","CLINIC",CLINIC)) Q:'CLINIC!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
...S RECALLIEN=0 F S RECALLIEN=$O(^SD(403.5,"E",CLINIC,RECALLIEN)) Q:'RECALLIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS")) D
....S DFN=$$GET1^DIQ(403.5,RECALLIEN,.01,"I") Q:'DFN
....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
....D FLTRRECALL^SDES2QRYAPREQSB(RECALLIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
Q
;
REQCHK(SDGMR,DFN) ;alb/sat 658 - new rules for consult check
N CPRSTAT,IFC,OSACT,OSPEND
Q:'$D(^GMR(123,+$G(SDGMR),0)) 1
S OSACT=$O(^ORD(100.01,"B","ACTIVE",0))
S OSPEND=$O(^ORD(100.01,"B","PENDING",0))
S CPRSTAT=$$GET1^DIQ(123,SDGMR_",",8,"I")
Q:'((CPRSTAT=OSACT)!(CPRSTAT=OSPEND)) 1
S IFC=$$GET1^DIQ(123,SDGMR,.125,"I")
Q:IFC="P" 1
Q 0
;
CHECKSERVICES(SDINPUT,SERVICEIEN) ;
N STOPCODES,FOUND,SFIENS,STOPCODE
S FOUND=0
D GETS^DIQ(123.5,SERVICEIEN_",","688*","IE","STOPCODES")
S SFIENS="" F S SFIENS=$O(STOPCODES(123.5688,SFIENS)) Q:SFIENS="" D
.S STOPCODE=$G(STOPCODES(123.5688,SFIENS,.01,"I")) Q:'STOPCODE
.I $D(SDINPUT("FILTER","SERVICE",STOPCODE)) S FOUND=1
Q FOUND
;
STOP(GMRSTOP,SDGMR) ;get stop codes from field 688 of REQUEST SERVICES file 123.5
; .GMRSTOP - returned array of STOP CODE pointers to CLINIC STOP file 40.7
; GMRSTOP(<clinic stop id>)=<clinic stop name>
; SDGMR - (required) pointer to REQUEST/CONSULTATION file 123
N RS,SDDATA,SDI,SDIEN,SDNM
K GMRSTOP
S RS=$$GET1^DIQ(123,SDGMR_",",1,"I") ;get TO SERVICE
D GETS^DIQ(123.5,RS_",","688*","IE","SDDATA")
S SDI=0 F S SDI=$O(SDDATA(123.5688,SDI)) Q:SDI="" D
.S SDIEN=$G(SDDATA(123.5688,SDI,.01,"I"))
.S SDNM=$G(SDDATA(123.5688,SDI,.01,"E"))
.S:+SDIEN GMRSTOP(SDIEN)=SDNM
Q
;
GETSVC(GMRSVC,SVC) ;get REQUEST SERVICES entries for given stop codes
; .GMRSVC - returned array of REQUEST SERVICES entries
; .SVC - input array of clinic stop codes SVC(NAME)=ID pointer to CLINIC STOP file 40.7
N AB1,ID,SDN,STOP
K GMRSVC
S SDN="" F S SDN=$O(SVC(SDN)) Q:SDN="" D
.I SVC(SDN)="" Q
.S STOP=SVC(SDN) I '$D(^DIC(40.7,STOP,0)) Q
.S ID=0 F S ID=$O(^GMR(123.5,"AB1",STOP,ID)) Q:ID="" D
..S AB1=0 F S AB1=$O(^GMR(123.5,"AB1",STOP,ID,AB1)) Q:AB1="" D
...Q:STOP'=$P($G(^GMR(123.5,ID,688,AB1,0)),U,1)
...S GMRSVC(ID)=""
Q
;
PRIO(SDGMR) ;
N CNT,F81,FED,PRIO,PRIO1,RET,SDED,SDI ;alb/sat 658 added CNT, F81 and SDI
;alb/sat 658 start modification - if GMRC*3.0*81 has been installed/loaded at or before the file entry date/time, then always use the Earliest Date (Clinically Indicated Date)
S F81=9999999
S CNT=$$INSTALDT^XPDUTL("GMRC*3.0*81",.RET)
I CNT>0 S F81=$O(RET(0))
S SDED=$P($$GET1^DIQ(123,SDGMR_",",17,"I"),".",1) ;earliest date ;ICR 6185 ;alb/sat 658 moved this and next line up from under 'S PRIO=""'
S FED=$P($$GET1^DIQ(123,SDGMR_",",.01,"I"),".",1) ;file entry date ;ICR 4837
S PRIO=""
I F81'>FED S PRIO=SDED Q PRIO
;alb/sat 658 end modification
S PRIO1=$$GET1^DIQ(123,SDGMR_",",5) ;urgency text ;ICR 4837
I SDED="" S PRIO=PRIO1 ;2.6.17.2 - use URGENCY text if EARLIEST DATE is null
I (PRIO=""),(FED="")!(SDED'=FED) S PRIO=SDED ;2.6.17.1 - use EARLIEST DATE if not = FILE ENTRY DATE
I (PRIO=""),((PRIO1["STAT")!(PRIO1["NEXT AVAILABLE")!(PRIO1["EMERGENCY")!(PRIO1["TODAY")) S PRIO=SDED ;2.6.17.3
S:PRIO="" PRIO=PRIO1 ;2.6.17.3
Q PRIO ;alb/sat 658 added PRIOX tag
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2QRYAPREQSA 12346 printed Nov 22, 2024@18:04:25 Page 2
SDES2QRYAPREQSA ;ALB/BWF - QUERY APPOINTMENT REQUESTS; JAN 4,2023
+1 ;;5.3;Scheduling;**869,875,885**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
FINDBYREQ(ERRORS,SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT) ;
+1 NEW REQCNT,DFN,PRIORITYGROUP,CURRENTENR,PATSVCCONN,PATSCPERCENT,COUNT,REQCNT,CLINIEN,REQIEN,REQDATE,STOPDATE
+2 NEW PGROUP,CLINIC,FLTRPRIOGROUP,SERVICELIST,STAT,STOPCDATE,CONSIEN,GMRSERVICE,INVSTART,RECALLIEN,SERVICE
+3 SET COUNT=0
+4 ;
+5 ; appointment requests
+6 ;
+7 IF $DATA(SDINPUT("FILTER","REQUEST TYPE","APPT"))!($DATA(SDINPUT("FILTER","REQUEST TYPE","ALL")))
Begin DoDot:1
+8 SET REQCNT=0
+9 ; by clinic
+10 IF $DATA(SDINPUT("FILTER","CLINIC"))
Begin DoDot:2
+11 SET CLINIEN=0
FOR
SET CLINIEN=$ORDER(SDINPUT("FILTER","CLINIC",CLINIEN))
if 'CLINIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:3
+12 ; use GCC when filtering by PID DATE
+13 IF FLTRPIDDATE'=""
Begin DoDot:4
+14 SET REQIEN=0
FOR
SET REQIEN=$ORDER(^SDEC(409.85,"ECC","O",CLINIEN,FLTRPIDDATE,REQIEN))
if 'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:5
+15 SET DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I")
if 'DFN
QUIT
+16 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+17 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+18 DO FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
End DoDot:5
End DoDot:4
QUIT
+19 ; use EC when not filtering by PID DATE
+20 SET REQDATE=$SELECT(FLTRORIGDATE:FLTRORIGDATE-.01,1:STARTDT-.01)
+21 SET STOPDATE=$SELECT(FLTRORIGDATE:FLTRORIGDATE_.9999,1:ENDDT)
+22 FOR
SET REQDATE=$ORDER(^SDEC(409.85,"EC","O",CLINIEN,REQDATE))
if 'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:4
+23 SET REQIEN=0
FOR
SET REQIEN=$ORDER(^SDEC(409.85,"EC","O",CLINIEN,REQDATE,REQIEN))
if 'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:5
+24 SET DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I")
if 'DFN
QUIT
+25 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+26 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+27 DO FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+28 ;
+29 ; by service
+30 IF $DATA(SDINPUT("FILTER","SERVICE"))
Begin DoDot:2
+31 SET SERVICE=0
FOR
SET SERVICE=$ORDER(SDINPUT("FILTER","SERVICE",SERVICE))
if 'SERVICE!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:3
+32 ;
+33 ; filter by PID date (aka desired date)
+34 IF FLTRPIDDATE
Begin DoDot:4
+35 SET REQDATE=FLTRPIDDATE-.01
+36 SET STOPDATE=FLTRPIDDATE_.9999
+37 FOR
SET REQDATE=$ORDER(^SDEC(409.85,"ESC","O",SERVICE,REQDATE))
if 'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:5
+38 SET REQIEN=0
FOR
SET REQIEN=$ORDER(^SDEC(409.85,"ESC","O",SERVICE,REQDATE,REQIEN))
if 'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:6
+39 SET DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I")
if 'DFN
QUIT
+40 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+41 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+42 DO FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
End DoDot:6
End DoDot:5
End DoDot:4
QUIT
+43 ;
+44 ; filter by enrollment priority
+45 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
Begin DoDot:4
+46 SET REQDATE=STARTDT-.01
+47 SET STOPDATE=ENDDT_.9999
+48 ; all groups
+49 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL"))
Begin DoDot:5
+50 SET PGROUP=""
FOR
SET PGROUP=$ORDER(^SDEC(409.85,"ESP","O",SERVICE,PGROUP))
if PGROUP=""!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:6
+51 FOR
SET REQDATE=$ORDER(^SDEC(409.85,"ESP","O",SERVICE,PGROUP,REQDATE))
if 'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:7
+52 SET REQIEN=0
FOR
SET REQIEN=$ORDER(^SDEC(409.85,"ESP","O",SERVICE,PGROUP,REQDATE,REQIEN))
if 'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:8
+53 SET DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I")
if 'DFN
QUIT
+54 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+55 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+56 DO FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
End DoDot:8
End DoDot:7
End DoDot:6
End DoDot:5
QUIT
+57 ; filter by specific groups - start at A to only pick up "GROUP n"
+58 SET FLTRPRIOGROUP="A"
FOR
SET FLTRPRIOGROUP=$ORDER(SDINPUT("FILTER","PRIORITY GROUP",FLTRPRIOGROUP))
if FLTRPRIOGROUP=""
QUIT
Begin DoDot:5
+59 SET PGROUP=$PIECE(FLTRPRIOGROUP," ",2)
+60 FOR
SET REQDATE=$ORDER(^SDEC(409.85,"ESP","O",SERVICE,PGROUP,REQDATE))
if 'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:6
+61 SET REQIEN=0
FOR
SET REQIEN=$ORDER(^SDEC(409.85,"ESP","O",SERVICE,PGROUP,REQDATE,REQIEN))
if 'REQIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:7
+62 SET DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I")
if 'DFN
QUIT
+63 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+64 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+65 DO FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
QUIT
+66 ;
+67 SET REQDATE=STARTDT-.01
+68 SET STOPDATE=ENDDT_.9999
+69 FOR
SET REQDATE=$ORDER(^SDEC(409.85,"ES","O",SERVICE,REQDATE))
if 'REQDATE!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:4
+70 SET REQIEN=0
FOR
SET REQIEN=$ORDER(^SDEC(409.85,"ES","O",SERVICE,REQDATE,REQIEN))
if 'REQIEN!(REQDATE>STOPDATE)!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:5
+71 SET DFN=$$GET1^DIQ(409.85,REQIEN,.01,"I")
if 'DFN
QUIT
+72 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+73 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+74 DO FLTRAPPTREQ^SDES2QRYAPREQSB(REQIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+75 ;
+76 ; consults
+77 IF $DATA(SDINPUT("FILTER","REQUEST TYPE","CONSULT"))!($DATA(SDINPUT("FILTER","REQUEST TYPE","ALL")))
Begin DoDot:1
+78 SET REQCNT=0
+79 ; by clinic
+80 IF $DATA(SDINPUT("FILTER","CLINIC"))
Begin DoDot:2
+81 SET CLINIC=0
FOR
SET CLINIC=$ORDER(SDINPUT("FILTER","CLINIC",CLINIC))
if 'CLINIC!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:3
+82 SET CONSIEN=0
FOR
SET CONSIEN=$ORDER(^GMR(123,"H",CLINIC,CONSIEN))
if 'CONSIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:4
+83 if $$REQCHK(CONSIEN)
QUIT
+84 SET DFN=$$GET1^DIQ(123,CONSIEN,.02,"I")
if 'DFN
QUIT
+85 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+86 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+87 DO FLTRCONSULT^SDES2QRYAPREQSB(CONSIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+88 ; by service
+89 IF $DATA(SDINPUT("FILTER","SERVICE"))
Begin DoDot:2
+90 SET SERVICE=0
FOR
SET SERVICE=$ORDER(SDINPUT("FILTER","SERVICE",SERVICE))
if 'SERVICE
QUIT
Begin DoDot:3
+91 SET SERVICELIST(SERVICE)=SERVICE
End DoDot:3
+92 DO GETSVC^SDES2QRYAPREQSA(.GMRSVC,.SERVICELIST)
+93 SET GMRSERVICE=0
FOR
SET GMRSERVICE=$ORDER(GMRSVC(GMRSERVICE))
if 'GMRSERVICE
QUIT
Begin DoDot:3
+94 SET OSACT=$ORDER(^ORD(100.01,"B","ACTIVE",0))
+95 SET OSPEND=$ORDER(^ORD(100.01,"B","PENDING",0))
+96 FOR STAT=OSACT,OSPEND
if REQCNT>SDINPUT("MAX NUMBER OF RECORDS")
QUIT
Begin DoDot:4
+97 if STAT=""
QUIT
+98 SET INVSTART=9999999-ENDDT-1
+99 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:5
+100 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:6
+101 if $$REQCHK(CONSIEN)
QUIT
+102 SET DFN=$$GET1^DIQ(123,CONSIEN,.02,"I")
if 'DFN
QUIT
+103 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+104 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+105 DO FLTRCONSULT^SDES2QRYAPREQSB(CONSIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+106 ;
+107 ; recalls
+108 IF $DATA(SDINPUT("FILTER","REQUEST TYPE","RECALL"))!($DATA(SDINPUT("FILTER","REQUEST TYPE","ALL")))
Begin DoDot:1
+109 SET REQCNT=0
+110 IF $DATA(SDINPUT("FILTER","CLINIC"))
Begin DoDot:2
+111 SET CLINIC=0
FOR
SET CLINIC=$ORDER(SDINPUT("FILTER","CLINIC",CLINIC))
if 'CLINIC!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:3
+112 SET RECALLIEN=0
FOR
SET RECALLIEN=$ORDER(^SD(403.5,"E",CLINIC,RECALLIEN))
if 'RECALLIEN!(REQCNT>SDINPUT("MAX NUMBER OF RECORDS"))
QUIT
Begin DoDot:4
+113 SET DFN=$$GET1^DIQ(403.5,RECALLIEN,.01,"I")
if 'DFN
QUIT
+114 DO GETPATENR^SDES2QRYAPREQSB(DFN,.PRIORITYGROUP,.CURRENTENR,.PATSVCCONN,.PATSCPERCENT)
+115 IF $DATA(SDINPUT("FILTER","PRIORITY GROUP"))
IF ('$DATA(SDINPUT("FILTER","PRIORITY GROUP",PRIORITYGROUP))&'$DATA(SDINPUT("FILTER","PRIORITY GROUP","ALL")))
QUIT
+116 DO FLTRRECALL^SDES2QRYAPREQSB(RECALLIEN,.SDINPUT,FLTRORIGDATE,FLTRPIDDATE,STARTDT,ENDDT,PRIORITYGROUP,PATSVCCONN,PATSCPERCENT,.COUNT,.REQCNT)
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+117 QUIT
+118 ;
REQCHK(SDGMR,DFN) ;alb/sat 658 - new rules for consult check
+1 NEW CPRSTAT,IFC,OSACT,OSPEND
+2 if '$DATA(^GMR(123,+$GET(SDGMR),0))
QUIT 1
+3 SET OSACT=$ORDER(^ORD(100.01,"B","ACTIVE",0))
+4 SET OSPEND=$ORDER(^ORD(100.01,"B","PENDING",0))
+5 SET CPRSTAT=$$GET1^DIQ(123,SDGMR_",",8,"I")
+6 if '((CPRSTAT=OSACT)!(CPRSTAT=OSPEND))
QUIT 1
+7 SET IFC=$$GET1^DIQ(123,SDGMR,.125,"I")
+8 if IFC="P"
QUIT 1
+9 QUIT 0
+10 ;
CHECKSERVICES(SDINPUT,SERVICEIEN) ;
+1 NEW STOPCODES,FOUND,SFIENS,STOPCODE
+2 SET FOUND=0
+3 DO GETS^DIQ(123.5,SERVICEIEN_",","688*","IE","STOPCODES")
+4 SET SFIENS=""
FOR
SET SFIENS=$ORDER(STOPCODES(123.5688,SFIENS))
if SFIENS=""
QUIT
Begin DoDot:1
+5 SET STOPCODE=$GET(STOPCODES(123.5688,SFIENS,.01,"I"))
if 'STOPCODE
QUIT
+6 IF $DATA(SDINPUT("FILTER","SERVICE",STOPCODE))
SET FOUND=1
End DoDot:1
+7 QUIT FOUND
+8 ;
STOP(GMRSTOP,SDGMR) ;get stop codes from field 688 of REQUEST SERVICES file 123.5
+1 ; .GMRSTOP - returned array of STOP CODE pointers to CLINIC STOP file 40.7
+2 ; GMRSTOP(<clinic stop id>)=<clinic stop name>
+3 ; SDGMR - (required) pointer to REQUEST/CONSULTATION file 123
+4 NEW RS,SDDATA,SDI,SDIEN,SDNM
+5 KILL GMRSTOP
+6 ;get TO SERVICE
SET RS=$$GET1^DIQ(123,SDGMR_",",1,"I")
+7 DO GETS^DIQ(123.5,RS_",","688*","IE","SDDATA")
+8 SET SDI=0
FOR
SET SDI=$ORDER(SDDATA(123.5688,SDI))
if SDI=""
QUIT
Begin DoDot:1
+9 SET SDIEN=$GET(SDDATA(123.5688,SDI,.01,"I"))
+10 SET SDNM=$GET(SDDATA(123.5688,SDI,.01,"E"))
+11 if +SDIEN
SET GMRSTOP(SDIEN)=SDNM
End DoDot:1
+12 QUIT
+13 ;
GETSVC(GMRSVC,SVC) ;get REQUEST SERVICES entries for given stop codes
+1 ; .GMRSVC - returned array of REQUEST SERVICES entries
+2 ; .SVC - input array of clinic stop codes SVC(NAME)=ID pointer to CLINIC STOP file 40.7
+3 NEW AB1,ID,SDN,STOP
+4 KILL GMRSVC
+5 SET SDN=""
FOR
SET SDN=$ORDER(SVC(SDN))
if SDN=""
QUIT
Begin DoDot:1
+6 IF SVC(SDN)=""
QUIT
+7 SET STOP=SVC(SDN)
IF '$DATA(^DIC(40.7,STOP,0))
QUIT
+8 SET ID=0
FOR
SET ID=$ORDER(^GMR(123.5,"AB1",STOP,ID))
if ID=""
QUIT
Begin DoDot:2
+9 SET AB1=0
FOR
SET AB1=$ORDER(^GMR(123.5,"AB1",STOP,ID,AB1))
if AB1=""
QUIT
Begin DoDot:3
+10 if STOP'=$PIECE($GET(^GMR(123.5,ID,688,AB1,0)),U,1)
QUIT
+11 SET GMRSVC(ID)=""
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
PRIO(SDGMR) ;
+1 ;alb/sat 658 added CNT, F81 and SDI
NEW CNT,F81,FED,PRIO,PRIO1,RET,SDED,SDI
+2 ;alb/sat 658 start modification - if GMRC*3.0*81 has been installed/loaded at or before the file entry date/time, then always use the Earliest Date (Clinically Indicated Date)
+3 SET F81=9999999
+4 SET CNT=$$INSTALDT^XPDUTL("GMRC*3.0*81",.RET)
+5 IF CNT>0
SET F81=$ORDER(RET(0))
+6 ;earliest date ;ICR 6185 ;alb/sat 658 moved this and next line up from under 'S PRIO=""'
SET SDED=$PIECE($$GET1^DIQ(123,SDGMR_",",17,"I"),".",1)
+7 ;file entry date ;ICR 4837
SET FED=$PIECE($$GET1^DIQ(123,SDGMR_",",.01,"I"),".",1)
+8 SET PRIO=""
+9 IF F81'>FED
SET PRIO=SDED
QUIT PRIO
+10 ;alb/sat 658 end modification
+11 ;urgency text ;ICR 4837
SET PRIO1=$$GET1^DIQ(123,SDGMR_",",5)
+12 ;2.6.17.2 - use URGENCY text if EARLIEST DATE is null
IF SDED=""
SET PRIO=PRIO1
+13 ;2.6.17.1 - use EARLIEST DATE if not = FILE ENTRY DATE
IF (PRIO="")
IF (FED="")!(SDED'=FED)
SET PRIO=SDED
+14 ;2.6.17.3
IF (PRIO="")
IF ((PRIO1["STAT")!(PRIO1["NEXT AVAILABLE")!(PRIO1["EMERGENCY")!(PRIO1["TODAY"))
SET PRIO=SDED
+15 ;2.6.17.3
if PRIO=""
SET PRIO=PRIO1
+16 ;alb/sat 658 added PRIOX tag
QUIT PRIO
