- 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 Jan 18, 2025@03:55:39 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