- SDECRMG ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ;MAR 15, 2017
- ;;5.3;Scheduling;**627,658**;Aug 13, 1993;Build 23
- ;
- Q
- ;
- ; Get data for GUI Request Management Grid display from:
- ; SD WAIT LIST
- ; RECALL REMINDERS
- ; REQUEST/CONSULTATION
- ; SDEC APPT REQUEST
- RMG(DATA,MAXREC,LASTSUB,FILTERIN,SORTIN,MGIENS,SDMAX) ;GET Request management Grid data
- ;INPUT:
- ; MAXREC - (optional) Max records returned
- ; LASTSUB - (optional) last subscripts from previous call
- ; FILTERIN - (optional) list of filters separated by pipe |
- ; each | piece will contain the following ^ pieces
- ; <filterName> ^ <value>
- ; SORTIN - (optional) list of sort criteria separated by pipe |
- ; MGIENS - (optional) list of IENs separated by pipe | to be sorted to the top of the return
- ; each IEN needs to be prefaced by the request type initial:
- ; A = APPT A123
- ; E = EWL E123
- ; C = Consult C123 ;not implemented
- ; R = Recall R123 ;not implemented
- ; SDMAX - (optional) Max records allowed to be accumulated
- ;
- ;RETURN:
- ; Temp global containing the TYPE, IEN, KEY
- N FILTER,MORE,SORT
- S SDMAX=$G(SDMAX,200)
- K ^TMP("SDECRMG",$J)
- ;validate MAXREC
- S MAXREC=$G(MAXREC)
- S:'MAXREC MAXREC=9999999 ;MAXREC=25
- I $G(LASTSUB)'="" D GETMORE(.DATA,LASTSUB,MAXREC) Q
- E D
- .K ^TMP("SDECIDX",$J)
- .S FILTERIN=$G(FILTERIN)
- .S SORTIN=$G(SORTIN)
- .S MGIENS=$G(MGIENS)
- .D:FILTERIN'="" VALFIL(FILTERIN,.FILTER)
- .D:SORTIN'="" VALSORT(SORTIN,.SORT)
- .D:MGIENS'="" IEN(.MGIENS)
- .D QUERY(MAXREC,.FILTER,.SORT,SDMAX,.MORE,.MGIENS)
- .S LASTSUB=""
- .D GETMORE(.DATA,LASTSUB,MAXREC,MORE)
- Q
- QUERY(MAXREC,FILTER,SORT,SDMAX,MORE,MGIENS) ;
- N I,SDECI,SDHDR,SDI,SDIDX,SDIC,SDRET,DFN,SDAPTYP,SDBEG,SCVISIT,SVCCONNP,PRIGRP,DESDT,ORIGDT,ORIGDTR
- N %DT,X,Y,FIL,DATA,PRI,PTLST,PTS,TMP,TMP1,CLINIC,CNT,ORIG,DESDTR,ID,SDSVC,SDSVCN,SVCR,SVCCONP,URG,MRTC ;alb/jsm 658 added MRTC
- S (CNT,MORE,SDECI,SDIC)=0
- S (CLINIC,MRTC,SDALL,SDAPTYP,SDBEG,SDEND,SDSVC,SORT,PTLST,SVCCONNP,SVCR,SCVISIT,PRI,PRIGRP,PTS,DESDT,DESDTR,ORIGDT,ORIGDTR,URG,MRTC)=""
- ;Loop through the filters and set up the variables)
- I '$D(FILTER) D
- .S FILTER(1)="WAITTIME^>90"
- .S FILTER(2)="REQUESTTYPE^E~A~R~C"
- I $D(SORT)'>1 D
- .S SORT(1)="PRIORITYGROUP"
- .S SORT(2)="DESIREDDATE"
- .S SORT(3)="ORIGINATIONDATE"
- .S SORT("D")=1
- ;
- S FIL=0 F S FIL=$O(FILTER(FIL)) Q:FIL'>0 D
- .S DATA=$G(FILTER(FIL))
- .I $P(DATA,U,1)="ALL" D
- ..S TMP=$P(DATA,U,2)
- ..F I=1:1:$L(TMP,"~") D
- ...S ID=$P(TMP,"~",I)
- ...I "ACER"[ID S SDALL(ID)="" S SDALL=1
- .I $P(DATA,U,1)="CLINICS" D
- ..S TMP=$P(DATA,U,2)
- ..F I=1:1:$L(TMP,"~") D
- ...Q:$P(TMP,"~",I)="" ;alb/sat 658
- ...S ID=$$VALCL($P(TMP,"~",I))
- ...I ID>0 S CLINIC(ID)=""
- ...S CLINIC=CLINIC_$S(CLINIC'="":"|",1:"")_ID
- ..;I $D(CLINIC)>0 S CLINIC=1
- .I $P(DATA,U,1)="DESIREDDATE" D
- ..S TMP=$P(DATA,U,2)
- ..F I=1:1:$L(TMP,"~") D
- ...S ID=$$DESDT($P(TMP,"~",I))
- ...I ID>0 S DESDT(ID)="",DESDT=DESDT_$S(DESDT'="":"|",1:"")_ID
- ..I DESDT'="" D
- ...;S DESDT=1
- ...D SFILTER(.FILTER,"WAITTIME","ALL DAYS")
- ...S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
- ...S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
- .I $P(DATA,U,1)="DESIREDDATERANGE" D
- ..S TMP=$P(DATA,U,2)
- ..S DESDTR=$$DESDTR(TMP)
- ..D SFILTER(.FILTER,"WAITTIME","ALL DAYS")
- ..S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
- ..S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
- .I $P(DATA,U,1)="MRTC" S MRTC=+$P(DATA,U,2) ;alb/jsm 658
- .I $P(DATA,U,1)="PATIENTNAME" D
- ..S TMP=$P(DATA,U,2)
- ..F I=1:1:$L(TMP,"~") S:$P(TMP,"~",I)'="" PTS($P(TMP,"~",I))=""
- ..D VALPT(.PTS)
- ..I $D(PTS)>0 S PTS=1
- .I $P(DATA,U,1)="ORIGINATIONDATE" D
- ..S TMP=$P(DATA,U,2)
- ..F I=1:1:$L(TMP,"~") D
- ...S ID=$$ORIG($P(TMP,"~",I))
- ...I ID>0 S ORIGDT(ID)="" S ORIGDT=ORIGDT_$S(ORIGDT'="":"|",1:"")_ID
- ...S SDBEG=$S(SDBEG="":ID,SDBEG>ID:ID,1:SDBEG)
- ...S SDEND=$S(SDEND="":ID,ID>SDEND:ID,1:SDEND)
- ..I $D(ORIGDT)>0 D
- ...;S ORIGDT=1
- ...D SFILTER(.FILTER,"WAITTIME","ALL DAYS")
- .I $P(DATA,U,1)="ORIGDATERANGE" D
- ..S TMP=$P(DATA,U,2)
- ..S ORIGDTR=$$DESDTR(TMP)
- ..D SFILTER(.FILTER,"WAITTIME","ALL DAYS")
- ..S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
- ..S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
- .I $P(DATA,U,1)="PRIORITYGROUPS" D
- ..S TMP=$P(DATA,U,2)
- ..F I=1:1:$L(TMP,"~") S TMP1=$P(TMP,"~",I) S:TMP1="NULL" TMP1="GROUP 0" S PRI(TMP1)=""
- ..D VALPRI(.PRI)
- ..I $D(PRI)>0 S PRIGRP=1
- .I $P(DATA,U,1)="REQUESTTYPE" D
- ..I $P(DATA,U,2)="" S SDAPTYP="E~A~R~C"
- ..E S SDAPTYP=$P(DATA,U,2)
- ..D VALSD
- .I $P(DATA,U,1)="SCVISIT" D ;SCVISIT is Service Connected? in Query - SCVISIT compared to the patient's SERVICE CONNECTED
- ..S TMP=$P(DATA,U,2)
- ..S SCVISIT=$S($$UP^XLFSTR(TMP)="FALSE":"NO",$$UP^XLFSTR(TMP)="TRUE":"YES",$$UP^XLFSTR(TMP)="BOTH":"",1:TMP)
- .I $P(DATA,U,1)="SERVICERELATED" D ;SERVICE RELATED is SCVISIT in QUERY - SVCR compared to field 15 in SD WAIT LIST and SDEC APPT REQUEST
- ..S TMP=$P(DATA,U,2)
- ..S SVCR=$S($$UP^XLFSTR(TMP)="NO":"NO",$$UP^XLFSTR(TMP)="FALSE":"NO",$$UP^XLFSTR(TMP)="YES":"YES",$$UP^XLFSTR(TMP)="TRUE":"YES",$$UP^XLFSTR(TMP)="BOTH":"",1:"")
- .I $P(DATA,U,1)="SERVICES" D ;SERVICES are clinic stop pointers to the CLINIC STOP file
- ..S TMP=$P(DATA,U,2)
- ..F I=1:1:$L(TMP,"~") S SDSVCN=$$GET1^DIQ(40.7,+$P(TMP,"~",I)_",",.01) S:SDSVCN'="" SDSVC(SDSVCN)=+$P(TMP,"~",I),SDSVC=1 ;alb/sat 658 set SDSVC()=ien
- .I $P(DATA,U,1)="WAITTIME",SDBEG="",SDEND="" D
- ..S TMP=$P(DATA,U,2)
- ..S SDBEG=$S(TMP["ALL DAYS":"",TMP="<30":"29",TMP="30-60":"60",TMP="60-90":"90",TMP=">=90":"",1:"")
- ..S SDEND=$S(TMP["ALL DAYS":"",TMP="<30":"DT",TMP="30-60":"30",TMP="60-90":"60",TMP=">=90":"90",1:"90")
- ..D VALID
- .I $P(DATA,U,1)="URGENCY" D
- ..S TMP=$P(DATA,U,2)
- ..F I=1:1:$L(TMP,"~") I $D(^ORD(101,+$P(TMP,"~",I),0)) S URG($P(TMP,"~",I))="",URG=1
- ..S:$D(URG)>1 SDAPTYP="C"
- I SDAPTYP="" S SDAPTYP="A~E~R~C"
- ;
- ;Now let's find our patients
- I $D(PTS)>1 D PATIENT(.PTS,SDAPTYP,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,PRIGRP,.SORT,SDMAX,.URG,.SDSVC,.MORE,.ORIGDTR,DESDTR,.MGIENS,.SDALL,.MRTC) ;alb/jsm 658 added MRTC
- E D REQUEST(SDAPTYP,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.MORE,.ORIGDTR,DESDTR,.MGIENS,.SDALL,.MRTC) ;alb/jsm 658 added MRTC
- S ^TMP("SDECIDX",$J,"MORE")=+MORE
- Q
- VALID ;validate begin date
- S SDBEG=$G(SDBEG)
- I SDBEG'="" S %DT="" S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-SDBEG)
- I SDBEG="" S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
- ;validate end date
- S SDEND=$G(SDEND)
- I SDEND'="" S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-SDEND)
- I SDEND="" S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
- Q
- VALPT(PTS) ;Validate patients
- ;validate DFN
- N LP
- S LP="" F S LP=$O(PTS(LP)) Q:LP="" D
- .I '$D(^DPT(LP,0)) K PTS(LP)
- Q
- VALSD(SDAPTYP) ;validate SDAPTYP
- S SDAPTYP=$G(SDAPTYP)
- S:SDAPTYP="" SDAPTYP="ACER"
- I "ACER"'[SDAPTYP S @SDECY@(1)="-1^Invalid Request Type." Q
- Q
- VALPRI(PRI) ;validate PRIGRP
- N LP,TMP
- S PRI=""
- S LP="" F S LP=$O(PRI(LP)) Q:LP="" D
- .S TMP=LP
- .I TMP="" S TMP="GROUP 0"
- .I TMP'="GROUP 0",TMP'="GROUP 1",TMP'="GROUP 2",TMP'="GROUP 3",TMP'="GROUP 4",TMP'="GROUP 5",TMP'="GROUP 6",TMP'="GROUP 7",TMP'="GROUP 8" K PRI(LP)
- .E S PRI=PRI_$S(PRI'="":"|",1:"")_$E(TMP,7)
- Q
- DESDTR(DATA) ;validate desired date range and origination date range
- N %DT,SDBEG,SDEND,X,Y
- S SDBEG=$P(DATA,"~",1)
- I SDBEG'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y
- I (SDBEG="")!(SDBEG=-1) S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
- S SDEND=$P(DATA,"~",2)
- I SDEND'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y
- I (SDEND="")!(SDEND=-1) S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
- Q SDBEG_"~"_SDEND
- DESDT(DESDT) ;validate DESDT
- N %DT,X,Y
- I DESDT'="" S %DT="" S X=$P(DESDT,"@",1) D ^%DT S DESDT=Y
- Q DESDT
- ORIG(ORIG) ;validate ORIGDT
- N %DT,X,Y
- I ORIG'="" S %DT="" S X=$P(ORIG,"@",1) D ^%DT S ORIG=Y
- Q ORIG
- VALCL(CLINIC) ;validate Clinic
- N IEN
- ;is CLINIC an IEN
- I +CLINIC,$D(^SC(CLINIC,0)) Q CLINIC
- ;CLINIC is a name
- S IEN=""
- S IEN=$O(^SC("B",CLINIC,IEN))
- I IEN="" S IEN=0
- Q IEN
- VALFIL(FILTERIN,FILTER) ;validate filters and build FILTER array
- N SDC,SDI
- K FILTER
- S FILTERIN=$G(FILTERIN)
- Q:FILTERIN=""
- S SDC=0
- F SDI=1:1:$L(FILTERIN,"|") D
- .S SDC=SDC+1 S FILTER(SDC)=$P(FILTERIN,"|",SDI),FILTER("B",$P($P(FILTERIN,"|",SDI),"^",1),SDC)=$P(FILTERIN,"|",SDI)
- Q
- VALSORT(SORTIN,SORT) ;validate sorts and build SORT array
- N SDC,SDI
- K SORT
- S SORTIN=$G(SORTIN,"|")
- Q:SORTIN=""
- S SDC=0
- F SDI=1:1:$L(SORTIN,"|") D
- .S SDC=SDC+1 S (SORT("B",$P(SORTIN,"|",SDI),SDC),SORT(SDC))=$P(SORTIN,"|",SDI)
- Q
- IEN(MGIENS) ;build IEN array
- N SDI
- S MGIENS=$G(MGIENS)
- Q:MGIENS=""
- F SDI=1:1:$L(MGIENS,"|") D
- .S MGIENS($P(MGIENS,"|",SDI))=""
- Q
- REQUEST(SDAPTYP,SDBEG,SDEND,CLINIC,PRI,SCVISIT,SVCR,ORIGDT,DESDT,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,MORE,ORIGDTR,DESDTR,MGIENS,SDALL,MRTC) ;Filter first on request type
- N SDCNT,SDLAST,SDMAX1
- S SDCNT=0
- D:MGIENS'="" MGIENS^SDECRMG2(.MGIENS,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MRTC) ;alb/jsm 658 added MRTC
- S MORE=1
- I SDAPTYP["E" D WAIT^SDECRMG1(.RET,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MGIENS,.SDALL)
- Q:SDCNT'<SDMAX
- I SDAPTYP["A" D APPT^SDECRMG1(.RET,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MGIENS,.SDALL,.MRTC) ;alb/jsm 658 added MRTC
- Q:SDCNT'<SDMAX
- I SDAPTYP["C" D CONSULT^SDECRMG2(.RET,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,,.SDALL)
- Q:SDCNT'<SDMAX
- I SDAPTYP["R" D RECALL^SDECRMG1(.RET,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,,.SDALL)
- Q:SDCNT'<SDMAX
- S MORE=0
- Q
- PATIENT(PTS,SDAPTYP,SDBEG,SDEND,CLINIC,PRI,SCVISIT,SVCR,ORIGDT,DESDT,PRIGRP,SORT,SDMAX,URG,SDSVC,MORE,ORIGDTR,DESDTR,MGIENS,SDALL,MRTC) ;Filter first on patient
- N LOOP,DFN,SDCNT,SDLAST,SDMAX1
- S SDCNT=0
- D:MGIENS'="" MGIENS^SDECRMG2(.MGIENS,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MRTC) ;alb/jsm added MRTC
- S LOOP="" F S LOOP=$O(PTS(LOOP)) Q:LOOP="" D
- .S DFN=LOOP
- .S MORE=1
- .I (SDAPTYP["A")!(SDAPTYP["V") D APPT^SDECRMG1(.RET,MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MGIENS,.SDALL,.MRTC) ;alb/jsm 658 added MRTC
- .Q:SDCNT'<SDMAX
- .I SDAPTYP["C" D CONSULT^SDECRMG2(.RET,MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,,.SDALL)
- .Q:SDCNT'<SDMAX
- .I SDAPTYP["R" D RECALL^SDECRMG1(.RET,MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,,.SDALL)
- .Q:SDCNT'<SDMAX
- .I SDAPTYP["E" D WAIT^SDECRMG1(.RET,MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MGIENS,.SDALL)
- .Q:SDCNT'<SDMAX
- .S MORE=0
- Q
- GETMORE(DATA,LASTSUB,MAX,MORE) ;
- N LP,CNT,NODE
- S CNT=0,MAX=$G(MAX),MORE=$G(MORE)
- I MAX="" S MAX=25
- S DATA=$$TMPGBL
- S @DATA@(0)="T00030TYPE^T00030IEN^T00030KEY^T00030TOTAL^T00030MORE"_$C(30)
- S LP=LASTSUB F S LP=$O(^TMP("SDECIDX",$J,"XREF",LP)) Q:LP="" D Q:(CNT=MAX)
- .S NODE=$G(^TMP("SDECIDX",$J,"XREF",LP))
- .S $P(NODE,U,4)=$G(^TMP("SDECIDX",$J,"COUNT"))
- .S $P(NODE,U,5)=+$G(^TMP("SDECIDX",$J,"MORE"))
- .S CNT=CNT+1
- .S @DATA@(CNT)=NODE_$C(30)
- S @DATA@(CNT)=$P(@DATA@(CNT),$C(30))_$C(30,31)
- Q
- ;
- TMPGBL() ;EP-
- K ^TMP("SDECRMG",$J) Q $NA(^($J))
- ;
- CALIGN(DATA,SDHDR) ;
- N RET,SDI,SDPOS
- S RET=""
- F SDI=1:1:$L(DATA,U) D
- .S SDPOS=SDHDR("C",SDI)
- .S $P(RET,U,SDPOS)=$P(DATA,U,SDI)
- S $P(RET,U,SDHDR("C","RMGTYPE"))="C"
- Q RET
- ;
- GETNEXT(LASTSUB,MAXREC,SDECY) ;return next set of records
- N SD1,SD2,SD3,SD4,SD5,SDECI,SDIDX,SDSUB,SDTMP
- S MAXREC=$G(MAXREC,25)
- S SDIDX=$P(LASTSUB,"|",1)
- S SDSUB=""
- S SDECI=0
- S @SDECY@(SDECI)=@SDIDX@("HDR")
- S SD1=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:"") S $P(LASTSUB,"|",2)=""
- F S SD1=$O(@SDIDX@("DATA",SD1)) Q:SD1="" D I SDECI'<MAXREC S $P(SDSUB,"|",2)=SD1 Q
- .S SD2=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:"") S $P(LASTSUB,"|",3)=""
- .F S SD2=$O(@SDIDX@("DATA",SD1,SD2)) Q:SD2="" D I SDECI'<MAXREC S $P(SDSUB,"|",3)=SD2 Q
- ..S SD3=$S($P(LASTSUB,"|",4)'="":$P(LASTSUB,"|",4),1:"") S $P(LASTSUB,"|",4)=""
- ..F S SD3=$O(@SDIDX@("DATA",SD1,SD2,SD3)) Q:SD3="" D I SDECI'<MAXREC S $P(SDSUB,"|",4)=SD3 Q
- ...S SD4=$S($P(LASTSUB,"|",5)'="":$P(LASTSUB,"|",5),1:"") S $P(LASTSUB,"|",5)=""
- ...F S SD4=$O(@SDIDX@("DATA",SD1,SD2,SD3,SD4)) Q:SD4="" D I SDECI'<MAXREC S $P(SDSUB,"|",5)=SD4 Q
- ....S SD5=$S($P(LASTSUB,"|",6)'="":$P(LASTSUB,"|",6),1:"") S $P(LASTSUB,"|",6)=""
- ....F S SD5=$O(@SDIDX@("DATA",SD1,SD2,SD3,SD4,SD5)) Q:SD5="" D I SDECI'<MAXREC S $P(SDSUB,"|",6)=SD5 Q
- .....S SDECI=SDECI+1 S @SDECY@(SDECI)=@SDIDX@("DATA",SD1,SD2,SD3,SD4,SD5)_$C(30)
- I SDSUB="" K @SDIDX
- I SDSUB'="" D
- .S $P(SDSUB,"|",1)=SDIDX
- .S SDTMP=@SDECY@(SDECI)
- .S SDTMP=$P(SDTMP,$C(30),1)
- .S $P(SDTMP,U,@SDIDX@("LASTSUB"))=SDSUB
- .S @SDECY@(SDECI)=SDTMP_$C(30)
- S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
- Q
- ;
- SFILTER(FILTERS,FILTER1,FILVAL) ;set/change existing filter value
- N FILD
- S FILD="" F S FILD=$O(^FILTERS("B",FILTER1,FILD)) Q:FILD="" D
- .S $P(FILTERS(FILD),"^",2)=FILVAL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECRMG 14255 printed Feb 19, 2025@00:18:54 Page 2
- SDECRMG ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ;MAR 15, 2017
- +1 ;;5.3;Scheduling;**627,658**;Aug 13, 1993;Build 23
- +2 ;
- +3 QUIT
- +4 ;
- +5 ; Get data for GUI Request Management Grid display from:
- +6 ; SD WAIT LIST
- +7 ; RECALL REMINDERS
- +8 ; REQUEST/CONSULTATION
- +9 ; SDEC APPT REQUEST
- RMG(DATA,MAXREC,LASTSUB,FILTERIN,SORTIN,MGIENS,SDMAX) ;GET Request management Grid data
- +1 ;INPUT:
- +2 ; MAXREC - (optional) Max records returned
- +3 ; LASTSUB - (optional) last subscripts from previous call
- +4 ; FILTERIN - (optional) list of filters separated by pipe |
- +5 ; each | piece will contain the following ^ pieces
- +6 ; <filterName> ^ <value>
- +7 ; SORTIN - (optional) list of sort criteria separated by pipe |
- +8 ; MGIENS - (optional) list of IENs separated by pipe | to be sorted to the top of the return
- +9 ; each IEN needs to be prefaced by the request type initial:
- +10 ; A = APPT A123
- +11 ; E = EWL E123
- +12 ; C = Consult C123 ;not implemented
- +13 ; R = Recall R123 ;not implemented
- +14 ; SDMAX - (optional) Max records allowed to be accumulated
- +15 ;
- +16 ;RETURN:
- +17 ; Temp global containing the TYPE, IEN, KEY
- +18 NEW FILTER,MORE,SORT
- +19 SET SDMAX=$GET(SDMAX,200)
- +20 KILL ^TMP("SDECRMG",$JOB)
- +21 ;validate MAXREC
- +22 SET MAXREC=$GET(MAXREC)
- +23 ;MAXREC=25
- if 'MAXREC
- SET MAXREC=9999999
- +24 IF $GET(LASTSUB)'=""
- DO GETMORE(.DATA,LASTSUB,MAXREC)
- QUIT
- +25 IF '$TEST
- Begin DoDot:1
- +26 KILL ^TMP("SDECIDX",$JOB)
- +27 SET FILTERIN=$GET(FILTERIN)
- +28 SET SORTIN=$GET(SORTIN)
- +29 SET MGIENS=$GET(MGIENS)
- +30 if FILTERIN'=""
- DO VALFIL(FILTERIN,.FILTER)
- +31 if SORTIN'=""
- DO VALSORT(SORTIN,.SORT)
- +32 if MGIENS'=""
- DO IEN(.MGIENS)
- +33 DO QUERY(MAXREC,.FILTER,.SORT,SDMAX,.MORE,.MGIENS)
- +34 SET LASTSUB=""
- +35 DO GETMORE(.DATA,LASTSUB,MAXREC,MORE)
- End DoDot:1
- +36 QUIT
- QUERY(MAXREC,FILTER,SORT,SDMAX,MORE,MGIENS) ;
- +1 NEW I,SDECI,SDHDR,SDI,SDIDX,SDIC,SDRET,DFN,SDAPTYP,SDBEG,SCVISIT,SVCCONNP,PRIGRP,DESDT,ORIGDT,ORIGDTR
- +2 ;alb/jsm 658 added MRTC
- NEW %DT,X,Y,FIL,DATA,PRI,PTLST,PTS,TMP,TMP1,CLINIC,CNT,ORIG,DESDTR,ID,SDSVC,SDSVCN,SVCR,SVCCONP,URG,MRTC
- +3 SET (CNT,MORE,SDECI,SDIC)=0
- +4 SET (CLINIC,MRTC,SDALL,SDAPTYP,SDBEG,SDEND,SDSVC,SORT,PTLST,SVCCONNP,SVCR,SCVISIT,PRI,PRIGRP,PTS,DESDT,DESDTR,ORIGDT,ORIGDTR,URG,MRTC)=""
- +5 ;Loop through the filters and set up the variables)
- +6 IF '$DATA(FILTER)
- Begin DoDot:1
- +7 SET FILTER(1)="WAITTIME^>90"
- +8 SET FILTER(2)="REQUESTTYPE^E~A~R~C"
- End DoDot:1
- +9 IF $DATA(SORT)'>1
- Begin DoDot:1
- +10 SET SORT(1)="PRIORITYGROUP"
- +11 SET SORT(2)="DESIREDDATE"
- +12 SET SORT(3)="ORIGINATIONDATE"
- +13 SET SORT("D")=1
- End DoDot:1
- +14 ;
- +15 SET FIL=0
- FOR
- SET FIL=$ORDER(FILTER(FIL))
- if FIL'>0
- QUIT
- Begin DoDot:1
- +16 SET DATA=$GET(FILTER(FIL))
- +17 IF $PIECE(DATA,U,1)="ALL"
- Begin DoDot:2
- +18 SET TMP=$PIECE(DATA,U,2)
- +19 FOR I=1:1:$LENGTH(TMP,"~")
- Begin DoDot:3
- +20 SET ID=$PIECE(TMP,"~",I)
- +21 IF "ACER"[ID
- SET SDALL(ID)=""
- SET SDALL=1
- End DoDot:3
- End DoDot:2
- +22 IF $PIECE(DATA,U,1)="CLINICS"
- Begin DoDot:2
- +23 SET TMP=$PIECE(DATA,U,2)
- +24 FOR I=1:1:$LENGTH(TMP,"~")
- Begin DoDot:3
- +25 ;alb/sat 658
- if $PIECE(TMP,"~",I)=""
- QUIT
- +26 SET ID=$$VALCL($PIECE(TMP,"~",I))
- +27 IF ID>0
- SET CLINIC(ID)=""
- +28 SET CLINIC=CLINIC_$SELECT(CLINIC'="":"|",1:"")_ID
- End DoDot:3
- +29 ;I $D(CLINIC)>0 S CLINIC=1
- End DoDot:2
- +30 IF $PIECE(DATA,U,1)="DESIREDDATE"
- Begin DoDot:2
- +31 SET TMP=$PIECE(DATA,U,2)
- +32 FOR I=1:1:$LENGTH(TMP,"~")
- Begin DoDot:3
- +33 SET ID=$$DESDT($PIECE(TMP,"~",I))
- +34 IF ID>0
- SET DESDT(ID)=""
- SET DESDT=DESDT_$SELECT(DESDT'="":"|",1:"")_ID
- End DoDot:3
- +35 IF DESDT'=""
- Begin DoDot:3
- +36 ;S DESDT=1
- +37 DO SFILTER(.FILTER,"WAITTIME","ALL DAYS")
- +38 ;alb/sat 658 use valid FM range instead of 1000101
- SET SDBEG=1410102
- +39 ;alb/sat 658 use valid FM range instead of 9991231
- SET SDEND=4141015
- End DoDot:3
- End DoDot:2
- +40 IF $PIECE(DATA,U,1)="DESIREDDATERANGE"
- Begin DoDot:2
- +41 SET TMP=$PIECE(DATA,U,2)
- +42 SET DESDTR=$$DESDTR(TMP)
- +43 DO SFILTER(.FILTER,"WAITTIME","ALL DAYS")
- +44 ;alb/sat 658 use valid FM range instead of 1000101
- SET SDBEG=1410102
- +45 ;alb/sat 658 use valid FM range instead of 9991231
- SET SDEND=4141015
- End DoDot:2
- +46 ;alb/jsm 658
- IF $PIECE(DATA,U,1)="MRTC"
- SET MRTC=+$PIECE(DATA,U,2)
- +47 IF $PIECE(DATA,U,1)="PATIENTNAME"
- Begin DoDot:2
- +48 SET TMP=$PIECE(DATA,U,2)
- +49 FOR I=1:1:$LENGTH(TMP,"~")
- if $PIECE(TMP,"~",I)'=""
- SET PTS($PIECE(TMP,"~",I))=""
- +50 DO VALPT(.PTS)
- +51 IF $DATA(PTS)>0
- SET PTS=1
- End DoDot:2
- +52 IF $PIECE(DATA,U,1)="ORIGINATIONDATE"
- Begin DoDot:2
- +53 SET TMP=$PIECE(DATA,U,2)
- +54 FOR I=1:1:$LENGTH(TMP,"~")
- Begin DoDot:3
- +55 SET ID=$$ORIG($PIECE(TMP,"~",I))
- +56 IF ID>0
- SET ORIGDT(ID)=""
- SET ORIGDT=ORIGDT_$SELECT(ORIGDT'="":"|",1:"")_ID
- +57 SET SDBEG=$SELECT(SDBEG="":ID,SDBEG>ID:ID,1:SDBEG)
- +58 SET SDEND=$SELECT(SDEND="":ID,ID>SDEND:ID,1:SDEND)
- End DoDot:3
- +59 IF $DATA(ORIGDT)>0
- Begin DoDot:3
- +60 ;S ORIGDT=1
- +61 DO SFILTER(.FILTER,"WAITTIME","ALL DAYS")
- End DoDot:3
- End DoDot:2
- +62 IF $PIECE(DATA,U,1)="ORIGDATERANGE"
- Begin DoDot:2
- +63 SET TMP=$PIECE(DATA,U,2)
- +64 SET ORIGDTR=$$DESDTR(TMP)
- +65 DO SFILTER(.FILTER,"WAITTIME","ALL DAYS")
- +66 ;alb/sat 658 use valid FM range instead of 1000101
- SET SDBEG=1410102
- +67 ;alb/sat 658 use valid FM range instead of 9991231
- SET SDEND=4141015
- End DoDot:2
- +68 IF $PIECE(DATA,U,1)="PRIORITYGROUPS"
- Begin DoDot:2
- +69 SET TMP=$PIECE(DATA,U,2)
- +70 FOR I=1:1:$LENGTH(TMP,"~")
- SET TMP1=$PIECE(TMP,"~",I)
- if TMP1="NULL"
- SET TMP1="GROUP 0"
- SET PRI(TMP1)=""
- +71 DO VALPRI(.PRI)
- +72 IF $DATA(PRI)>0
- SET PRIGRP=1
- End DoDot:2
- +73 IF $PIECE(DATA,U,1)="REQUESTTYPE"
- Begin DoDot:2
- +74 IF $PIECE(DATA,U,2)=""
- SET SDAPTYP="E~A~R~C"
- +75 IF '$TEST
- SET SDAPTYP=$PIECE(DATA,U,2)
- +76 DO VALSD
- End DoDot:2
- +77 ;SCVISIT is Service Connected? in Query - SCVISIT compared to the patient's SERVICE CONNECTED
- IF $PIECE(DATA,U,1)="SCVISIT"
- Begin DoDot:2
- +78 SET TMP=$PIECE(DATA,U,2)
- +79 SET SCVISIT=$SELECT($$UP^XLFSTR(TMP)="FALSE":"NO",$$UP^XLFSTR(TMP)="TRUE":"YES",$$UP^XLFSTR(TMP)="BOTH":"",1:TMP)
- End DoDot:2
- +80 ;SERVICE RELATED is SCVISIT in QUERY - SVCR compared to field 15 in SD WAIT LIST and SDEC APPT REQUEST
- IF $PIECE(DATA,U,1)="SERVICERELATED"
- Begin DoDot:2
- +81 SET TMP=$PIECE(DATA,U,2)
- +82 SET SVCR=$SELECT($$UP^XLFSTR(TMP)="NO":"NO",$$UP^XLFSTR(TMP)="FALSE":"NO",$$UP^XLFSTR(TMP)="YES":"YES",$$UP^XLFSTR(TMP)="TRUE":"YES",$$UP^XLFSTR(TMP)="BOTH":"",1:"")
- End DoDot:2
- +83 ;SERVICES are clinic stop pointers to the CLINIC STOP file
- IF $PIECE(DATA,U,1)="SERVICES"
- Begin DoDot:2
- +84 SET TMP=$PIECE(DATA,U,2)
- +85 ;alb/sat 658 set SDSVC()=ien
- FOR I=1:1:$LENGTH(TMP,"~")
- SET SDSVCN=$$GET1^DIQ(40.7,+$PIECE(TMP,"~",I)_",",.01)
- if SDSVCN'=""
- SET SDSVC(SDSVCN)=+$PIECE(TMP,"~",I)
- SET SDSVC=1
- End DoDot:2
- +86 IF $PIECE(DATA,U,1)="WAITTIME"
- IF SDBEG=""
- IF SDEND=""
- Begin DoDot:2
- +87 SET TMP=$PIECE(DATA,U,2)
- +88 SET SDBEG=$SELECT(TMP["ALL DAYS":"",TMP="<30":"29",TMP="30-60":"60",TMP="60-90":"90",TMP=">=90":"",1:"")
- +89 SET SDEND=$SELECT(TMP["ALL DAYS":"",TMP="<30":"DT",TMP="30-60":"30",TMP="60-90":"60",TMP=">=90":"90",1:"90")
- +90 DO VALID
- End DoDot:2
- +91 IF $PIECE(DATA,U,1)="URGENCY"
- Begin DoDot:2
- +92 SET TMP=$PIECE(DATA,U,2)
- +93 FOR I=1:1:$LENGTH(TMP,"~")
- IF $DATA(^ORD(101,+$PIECE(TMP,"~",I),0))
- SET URG($PIECE(TMP,"~",I))=""
- SET URG=1
- +94 if $DATA(URG)>1
- SET SDAPTYP="C"
- End DoDot:2
- End DoDot:1
- +95 IF SDAPTYP=""
- SET SDAPTYP="A~E~R~C"
- +96 ;
- +97 ;Now let's find our patients
- +98 ;alb/jsm 658 added MRTC
- IF $DATA(PTS)>1
- DO PATIENT(.PTS,SDAPTYP,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,PRIGRP,.SORT,SDMAX,.URG,.SDSVC,.MORE,.ORIGDTR,DESDTR,.MGIENS,.SDALL,.MRTC)
- +99 ;alb/jsm 658 added MRTC
- IF '$TEST
- DO REQUEST(SDAPTYP,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.MORE,.ORIGDTR,DESDTR,.MGIENS,.SDALL,.MRTC)
- +100 SET ^TMP("SDECIDX",$JOB,"MORE")=+MORE
- +101 QUIT
- VALID ;validate begin date
- +1 SET SDBEG=$GET(SDBEG)
- +2 IF SDBEG'=""
- SET %DT=""
- SET SDBEG=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-SDBEG)
- +3 ;alb/sat 658 use valid FM range instead of 1000101
- IF SDBEG=""
- SET SDBEG=1410102
- +4 ;validate end date
- +5 SET SDEND=$GET(SDEND)
- +6 IF SDEND'=""
- SET SDEND=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-SDEND)
- +7 ;alb/sat 658 use valid FM range instead of 9991231
- IF SDEND=""
- SET SDEND=4141015
- +8 QUIT
- VALPT(PTS) ;Validate patients
- +1 ;validate DFN
- +2 NEW LP
- +3 SET LP=""
- FOR
- SET LP=$ORDER(PTS(LP))
- if LP=""
- QUIT
- Begin DoDot:1
- +4 IF '$DATA(^DPT(LP,0))
- KILL PTS(LP)
- End DoDot:1
- +5 QUIT
- VALSD(SDAPTYP) ;validate SDAPTYP
- +1 SET SDAPTYP=$GET(SDAPTYP)
- +2 if SDAPTYP=""
- SET SDAPTYP="ACER"
- +3 IF "ACER"'[SDAPTYP
- SET @SDECY@(1)="-1^Invalid Request Type."
- QUIT
- +4 QUIT
- VALPRI(PRI) ;validate PRIGRP
- +1 NEW LP,TMP
- +2 SET PRI=""
- +3 SET LP=""
- FOR
- SET LP=$ORDER(PRI(LP))
- if LP=""
- QUIT
- Begin DoDot:1
- +4 SET TMP=LP
- +5 IF TMP=""
- SET TMP="GROUP 0"
- +6 IF TMP'="GROUP 0"
- IF TMP'="GROUP 1"
- IF TMP'="GROUP 2"
- IF TMP'="GROUP 3"
- IF TMP'="GROUP 4"
- IF TMP'="GROUP 5"
- IF TMP'="GROUP 6"
- IF TMP'="GROUP 7"
- IF TMP'="GROUP 8"
- KILL PRI(LP)
- +7 IF '$TEST
- SET PRI=PRI_$SELECT(PRI'="":"|",1:"")_$EXTRACT(TMP,7)
- End DoDot:1
- +8 QUIT
- DESDTR(DATA) ;validate desired date range and origination date range
- +1 NEW %DT,SDBEG,SDEND,X,Y
- +2 SET SDBEG=$PIECE(DATA,"~",1)
- +3 IF SDBEG'=""
- SET %DT=""
- SET X=$PIECE(SDBEG,"@",1)
- DO ^%DT
- SET SDBEG=Y
- +4 ;alb/sat 658 use valid FM range instead of 1000101
- IF (SDBEG="")!(SDBEG=-1)
- SET SDBEG=1410102
- +5 SET SDEND=$PIECE(DATA,"~",2)
- +6 IF SDEND'=""
- SET %DT=""
- SET X=$PIECE(SDEND,"@",1)
- DO ^%DT
- SET SDEND=Y
- +7 ;alb/sat 658 use valid FM range instead of 9991231
- IF (SDEND="")!(SDEND=-1)
- SET SDEND=4141015
- +8 QUIT SDBEG_"~"_SDEND
- DESDT(DESDT) ;validate DESDT
- +1 NEW %DT,X,Y
- +2 IF DESDT'=""
- SET %DT=""
- SET X=$PIECE(DESDT,"@",1)
- DO ^%DT
- SET DESDT=Y
- +3 QUIT DESDT
- ORIG(ORIG) ;validate ORIGDT
- +1 NEW %DT,X,Y
- +2 IF ORIG'=""
- SET %DT=""
- SET X=$PIECE(ORIG,"@",1)
- DO ^%DT
- SET ORIG=Y
- +3 QUIT ORIG
- VALCL(CLINIC) ;validate Clinic
- +1 NEW IEN
- +2 ;is CLINIC an IEN
- +3 IF +CLINIC
- IF $DATA(^SC(CLINIC,0))
- QUIT CLINIC
- +4 ;CLINIC is a name
- +5 SET IEN=""
- +6 SET IEN=$ORDER(^SC("B",CLINIC,IEN))
- +7 IF IEN=""
- SET IEN=0
- +8 QUIT IEN
- VALFIL(FILTERIN,FILTER) ;validate filters and build FILTER array
- +1 NEW SDC,SDI
- +2 KILL FILTER
- +3 SET FILTERIN=$GET(FILTERIN)
- +4 if FILTERIN=""
- QUIT
- +5 SET SDC=0
- +6 FOR SDI=1:1:$LENGTH(FILTERIN,"|")
- Begin DoDot:1
- +7 SET SDC=SDC+1
- SET FILTER(SDC)=$PIECE(FILTERIN,"|",SDI)
- SET FILTER("B",$PIECE($PIECE(FILTERIN,"|",SDI),"^",1),SDC)=$PIECE(FILTERIN,"|",SDI)
- End DoDot:1
- +8 QUIT
- VALSORT(SORTIN,SORT) ;validate sorts and build SORT array
- +1 NEW SDC,SDI
- +2 KILL SORT
- +3 SET SORTIN=$GET(SORTIN,"|")
- +4 if SORTIN=""
- QUIT
- +5 SET SDC=0
- +6 FOR SDI=1:1:$LENGTH(SORTIN,"|")
- Begin DoDot:1
- +7 SET SDC=SDC+1
- SET (SORT("B",$PIECE(SORTIN,"|",SDI),SDC),SORT(SDC))=$PIECE(SORTIN,"|",SDI)
- End DoDot:1
- +8 QUIT
- IEN(MGIENS) ;build IEN array
- +1 NEW SDI
- +2 SET MGIENS=$GET(MGIENS)
- +3 if MGIENS=""
- QUIT
- +4 FOR SDI=1:1:$LENGTH(MGIENS,"|")
- Begin DoDot:1
- +5 SET MGIENS($PIECE(MGIENS,"|",SDI))=""
- End DoDot:1
- +6 QUIT
- REQUEST(SDAPTYP,SDBEG,SDEND,CLINIC,PRI,SCVISIT,SVCR,ORIGDT,DESDT,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,MORE,ORIGDTR,DESDTR,MGIENS,SDALL,MRTC) ;Filter first on request type
- +1 NEW SDCNT,SDLAST,SDMAX1
- +2 SET SDCNT=0
- +3 ;alb/jsm 658 added MRTC
- if MGIENS'=""
- DO MGIENS^SDECRMG2(.MGIENS,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MRTC)
- +4 SET MORE=1
- +5 IF SDAPTYP["E"
- DO WAIT^SDECRMG1(.RET,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MGIENS,.SDALL)
- +6 if SDCNT'<SDMAX
- QUIT
- +7 ;alb/jsm 658 added MRTC
- IF SDAPTYP["A"
- DO APPT^SDECRMG1(.RET,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MGIENS,.SDALL,.MRTC)
- +8 if SDCNT'<SDMAX
- QUIT
- +9 IF SDAPTYP["C"
- DO CONSULT^SDECRMG2(.RET,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,,.SDALL)
- +10 if SDCNT'<SDMAX
- QUIT
- +11 IF SDAPTYP["R"
- DO RECALL^SDECRMG1(.RET,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,,.SDALL)
- +12 if SDCNT'<SDMAX
- QUIT
- +13 SET MORE=0
- +14 QUIT
- PATIENT(PTS,SDAPTYP,SDBEG,SDEND,CLINIC,PRI,SCVISIT,SVCR,ORIGDT,DESDT,PRIGRP,SORT,SDMAX,URG,SDSVC,MORE,ORIGDTR,DESDTR,MGIENS,SDALL,MRTC) ;Filter first on patient
- +1 NEW LOOP,DFN,SDCNT,SDLAST,SDMAX1
- +2 SET SDCNT=0
- +3 ;alb/jsm added MRTC
- if MGIENS'=""
- DO MGIENS^SDECRMG2(.MGIENS,MAXREC,"",SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MRTC)
- +4 SET LOOP=""
- FOR
- SET LOOP=$ORDER(PTS(LOOP))
- if LOOP=""
- QUIT
- Begin DoDot:1
- +5 SET DFN=LOOP
- +6 SET MORE=1
- +7 ;alb/jsm 658 added MRTC
- IF (SDAPTYP["A")!(SDAPTYP["V")
- DO APPT^SDECRMG1(.RET,MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MGIENS,.SDALL,.MRTC)
- +8 if SDCNT'<SDMAX
- QUIT
- +9 IF SDAPTYP["C"
- DO CONSULT^SDECRMG2(.RET,MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,,.SDALL)
- +10 if SDCNT'<SDMAX
- QUIT
- +11 IF SDAPTYP["R"
- DO RECALL^SDECRMG1(.RET,MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,,.SDALL)
- +12 if SDCNT'<SDMAX
- QUIT
- +13 IF SDAPTYP["E"
- DO WAIT^SDECRMG1(.RET,MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLAST,.ORIGDTR,.SDCNT,.MGIENS,.SDALL)
- +14 if SDCNT'<SDMAX
- QUIT
- +15 SET MORE=0
- End DoDot:1
- +16 QUIT
- GETMORE(DATA,LASTSUB,MAX,MORE) ;
- +1 NEW LP,CNT,NODE
- +2 SET CNT=0
- SET MAX=$GET(MAX)
- SET MORE=$GET(MORE)
- +3 IF MAX=""
- SET MAX=25
- +4 SET DATA=$$TMPGBL
- +5 SET @DATA@(0)="T00030TYPE^T00030IEN^T00030KEY^T00030TOTAL^T00030MORE"_$CHAR(30)
- +6 SET LP=LASTSUB
- FOR
- SET LP=$ORDER(^TMP("SDECIDX",$JOB,"XREF",LP))
- if LP=""
- QUIT
- Begin DoDot:1
- +7 SET NODE=$GET(^TMP("SDECIDX",$JOB,"XREF",LP))
- +8 SET $PIECE(NODE,U,4)=$GET(^TMP("SDECIDX",$JOB,"COUNT"))
- +9 SET $PIECE(NODE,U,5)=+$GET(^TMP("SDECIDX",$JOB,"MORE"))
- +10 SET CNT=CNT+1
- +11 SET @DATA@(CNT)=NODE_$CHAR(30)
- End DoDot:1
- if (CNT=MAX)
- QUIT
- +12 SET @DATA@(CNT)=$PIECE(@DATA@(CNT),$CHAR(30))_$CHAR(30,31)
- +13 QUIT
- +14 ;
- TMPGBL() ;EP-
- +1 KILL ^TMP("SDECRMG",$JOB)
- QUIT $NAME(^($JOB))
- +2 ;
- CALIGN(DATA,SDHDR) ;
- +1 NEW RET,SDI,SDPOS
- +2 SET RET=""
- +3 FOR SDI=1:1:$LENGTH(DATA,U)
- Begin DoDot:1
- +4 SET SDPOS=SDHDR("C",SDI)
- +5 SET $PIECE(RET,U,SDPOS)=$PIECE(DATA,U,SDI)
- End DoDot:1
- +6 SET $PIECE(RET,U,SDHDR("C","RMGTYPE"))="C"
- +7 QUIT RET
- +8 ;
- GETNEXT(LASTSUB,MAXREC,SDECY) ;return next set of records
- +1 NEW SD1,SD2,SD3,SD4,SD5,SDECI,SDIDX,SDSUB,SDTMP
- +2 SET MAXREC=$GET(MAXREC,25)
- +3 SET SDIDX=$PIECE(LASTSUB,"|",1)
- +4 SET SDSUB=""
- +5 SET SDECI=0
- +6 SET @SDECY@(SDECI)=@SDIDX@("HDR")
- +7 SET SD1=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2),1:"")
- SET $PIECE(LASTSUB,"|",2)=""
- +8 FOR
- SET SD1=$ORDER(@SDIDX@("DATA",SD1))
- if SD1=""
- QUIT
- Begin DoDot:1
- +9 SET SD2=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:"")
- SET $PIECE(LASTSUB,"|",3)=""
- +10 FOR
- SET SD2=$ORDER(@SDIDX@("DATA",SD1,SD2))
- if SD2=""
- QUIT
- Begin DoDot:2
- +11 SET SD3=$SELECT($PIECE(LASTSUB,"|",4)'="":$PIECE(LASTSUB,"|",4),1:"")
- SET $PIECE(LASTSUB,"|",4)=""
- +12 FOR
- SET SD3=$ORDER(@SDIDX@("DATA",SD1,SD2,SD3))
- if SD3=""
- QUIT
- Begin DoDot:3
- +13 SET SD4=$SELECT($PIECE(LASTSUB,"|",5)'="":$PIECE(LASTSUB,"|",5),1:"")
- SET $PIECE(LASTSUB,"|",5)=""
- +14 FOR
- SET SD4=$ORDER(@SDIDX@("DATA",SD1,SD2,SD3,SD4))
- if SD4=""
- QUIT
- Begin DoDot:4
- +15 SET SD5=$SELECT($PIECE(LASTSUB,"|",6)'="":$PIECE(LASTSUB,"|",6),1:"")
- SET $PIECE(LASTSUB,"|",6)=""
- +16 FOR
- SET SD5=$ORDER(@SDIDX@("DATA",SD1,SD2,SD3,SD4,SD5))
- if SD5=""
- QUIT
- Begin DoDot:5
- +17 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)=@SDIDX@("DATA",SD1,SD2,SD3,SD4,SD5)_$CHAR(30)
- End DoDot:5
- IF SDECI'<MAXREC
- SET $PIECE(SDSUB,"|",6)=SD5
- QUIT
- End DoDot:4
- IF SDECI'<MAXREC
- SET $PIECE(SDSUB,"|",5)=SD4
- QUIT
- End DoDot:3
- IF SDECI'<MAXREC
- SET $PIECE(SDSUB,"|",4)=SD3
- QUIT
- End DoDot:2
- IF SDECI'<MAXREC
- SET $PIECE(SDSUB,"|",3)=SD2
- QUIT
- End DoDot:1
- IF SDECI'<MAXREC
- SET $PIECE(SDSUB,"|",2)=SD1
- QUIT
- +18 IF SDSUB=""
- KILL @SDIDX
- +19 IF SDSUB'=""
- Begin DoDot:1
- +20 SET $PIECE(SDSUB,"|",1)=SDIDX
- +21 SET SDTMP=@SDECY@(SDECI)
- +22 SET SDTMP=$PIECE(SDTMP,$CHAR(30),1)
- +23 SET $PIECE(SDTMP,U,@SDIDX@("LASTSUB"))=SDSUB
- +24 SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
- End DoDot:1
- +25 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
- +26 QUIT
- +27 ;
- SFILTER(FILTERS,FILTER1,FILVAL) ;set/change existing filter value
- +1 NEW FILD
- +2 SET FILD=""
- FOR
- SET FILD=$ORDER(^FILTERS("B",FILTER1,FILD))
- if FILD=""
- QUIT
- Begin DoDot:1
- +3 SET $PIECE(FILTERS(FILD),"^",2)=FILVAL
- End DoDot:1
- +4 QUIT