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 Oct 16, 2024@18:53:03 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
