Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDECRMG

SDECRMG.m

Go to the documentation of this file.
  1. SDECRMG ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ;MAR 15, 2017
  1. ;;5.3;Scheduling;**627,658**;Aug 13, 1993;Build 23
  1. ;
  1. Q
  1. ;
  1. ; Get data for GUI Request Management Grid display from:
  1. ; SD WAIT LIST
  1. ; RECALL REMINDERS
  1. ; REQUEST/CONSULTATION
  1. ; SDEC APPT REQUEST
  1. RMG(DATA,MAXREC,LASTSUB,FILTERIN,SORTIN,MGIENS,SDMAX) ;GET Request management Grid data
  1. ;INPUT:
  1. ; MAXREC - (optional) Max records returned
  1. ; LASTSUB - (optional) last subscripts from previous call
  1. ; FILTERIN - (optional) list of filters separated by pipe |
  1. ; each | piece will contain the following ^ pieces
  1. ; <filterName> ^ <value>
  1. ; SORTIN - (optional) list of sort criteria separated by pipe |
  1. ; MGIENS - (optional) list of IENs separated by pipe | to be sorted to the top of the return
  1. ; each IEN needs to be prefaced by the request type initial:
  1. ; A = APPT A123
  1. ; E = EWL E123
  1. ; C = Consult C123 ;not implemented
  1. ; R = Recall R123 ;not implemented
  1. ; SDMAX - (optional) Max records allowed to be accumulated
  1. ;
  1. ;RETURN:
  1. ; Temp global containing the TYPE, IEN, KEY
  1. N FILTER,MORE,SORT
  1. S SDMAX=$G(SDMAX,200)
  1. K ^TMP("SDECRMG",$J)
  1. ;validate MAXREC
  1. S MAXREC=$G(MAXREC)
  1. S:'MAXREC MAXREC=9999999 ;MAXREC=25
  1. I $G(LASTSUB)'="" D GETMORE(.DATA,LASTSUB,MAXREC) Q
  1. E D
  1. .K ^TMP("SDECIDX",$J)
  1. .S FILTERIN=$G(FILTERIN)
  1. .S SORTIN=$G(SORTIN)
  1. .S MGIENS=$G(MGIENS)
  1. .D:FILTERIN'="" VALFIL(FILTERIN,.FILTER)
  1. .D:SORTIN'="" VALSORT(SORTIN,.SORT)
  1. .D:MGIENS'="" IEN(.MGIENS)
  1. .D QUERY(MAXREC,.FILTER,.SORT,SDMAX,.MORE,.MGIENS)
  1. .S LASTSUB=""
  1. .D GETMORE(.DATA,LASTSUB,MAXREC,MORE)
  1. Q
  1. QUERY(MAXREC,FILTER,SORT,SDMAX,MORE,MGIENS) ;
  1. N I,SDECI,SDHDR,SDI,SDIDX,SDIC,SDRET,DFN,SDAPTYP,SDBEG,SCVISIT,SVCCONNP,PRIGRP,DESDT,ORIGDT,ORIGDTR
  1. 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
  1. S (CNT,MORE,SDECI,SDIC)=0
  1. S (CLINIC,MRTC,SDALL,SDAPTYP,SDBEG,SDEND,SDSVC,SORT,PTLST,SVCCONNP,SVCR,SCVISIT,PRI,PRIGRP,PTS,DESDT,DESDTR,ORIGDT,ORIGDTR,URG,MRTC)=""
  1. ;Loop through the filters and set up the variables)
  1. I '$D(FILTER) D
  1. .S FILTER(1)="WAITTIME^>90"
  1. .S FILTER(2)="REQUESTTYPE^E~A~R~C"
  1. I $D(SORT)'>1 D
  1. .S SORT(1)="PRIORITYGROUP"
  1. .S SORT(2)="DESIREDDATE"
  1. .S SORT(3)="ORIGINATIONDATE"
  1. .S SORT("D")=1
  1. ;
  1. S FIL=0 F S FIL=$O(FILTER(FIL)) Q:FIL'>0 D
  1. .S DATA=$G(FILTER(FIL))
  1. .I $P(DATA,U,1)="ALL" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..F I=1:1:$L(TMP,"~") D
  1. ...S ID=$P(TMP,"~",I)
  1. ...I "ACER"[ID S SDALL(ID)="" S SDALL=1
  1. .I $P(DATA,U,1)="CLINICS" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..F I=1:1:$L(TMP,"~") D
  1. ...Q:$P(TMP,"~",I)="" ;alb/sat 658
  1. ...S ID=$$VALCL($P(TMP,"~",I))
  1. ...I ID>0 S CLINIC(ID)=""
  1. ...S CLINIC=CLINIC_$S(CLINIC'="":"|",1:"")_ID
  1. ..;I $D(CLINIC)>0 S CLINIC=1
  1. .I $P(DATA,U,1)="DESIREDDATE" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..F I=1:1:$L(TMP,"~") D
  1. ...S ID=$$DESDT($P(TMP,"~",I))
  1. ...I ID>0 S DESDT(ID)="",DESDT=DESDT_$S(DESDT'="":"|",1:"")_ID
  1. ..I DESDT'="" D
  1. ...;S DESDT=1
  1. ...D SFILTER(.FILTER,"WAITTIME","ALL DAYS")
  1. ...S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
  1. ...S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
  1. .I $P(DATA,U,1)="DESIREDDATERANGE" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..S DESDTR=$$DESDTR(TMP)
  1. ..D SFILTER(.FILTER,"WAITTIME","ALL DAYS")
  1. ..S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
  1. ..S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
  1. .I $P(DATA,U,1)="MRTC" S MRTC=+$P(DATA,U,2) ;alb/jsm 658
  1. .I $P(DATA,U,1)="PATIENTNAME" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..F I=1:1:$L(TMP,"~") S:$P(TMP,"~",I)'="" PTS($P(TMP,"~",I))=""
  1. ..D VALPT(.PTS)
  1. ..I $D(PTS)>0 S PTS=1
  1. .I $P(DATA,U,1)="ORIGINATIONDATE" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..F I=1:1:$L(TMP,"~") D
  1. ...S ID=$$ORIG($P(TMP,"~",I))
  1. ...I ID>0 S ORIGDT(ID)="" S ORIGDT=ORIGDT_$S(ORIGDT'="":"|",1:"")_ID
  1. ...S SDBEG=$S(SDBEG="":ID,SDBEG>ID:ID,1:SDBEG)
  1. ...S SDEND=$S(SDEND="":ID,ID>SDEND:ID,1:SDEND)
  1. ..I $D(ORIGDT)>0 D
  1. ...;S ORIGDT=1
  1. ...D SFILTER(.FILTER,"WAITTIME","ALL DAYS")
  1. .I $P(DATA,U,1)="ORIGDATERANGE" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..S ORIGDTR=$$DESDTR(TMP)
  1. ..D SFILTER(.FILTER,"WAITTIME","ALL DAYS")
  1. ..S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
  1. ..S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
  1. .I $P(DATA,U,1)="PRIORITYGROUPS" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..F I=1:1:$L(TMP,"~") S TMP1=$P(TMP,"~",I) S:TMP1="NULL" TMP1="GROUP 0" S PRI(TMP1)=""
  1. ..D VALPRI(.PRI)
  1. ..I $D(PRI)>0 S PRIGRP=1
  1. .I $P(DATA,U,1)="REQUESTTYPE" D
  1. ..I $P(DATA,U,2)="" S SDAPTYP="E~A~R~C"
  1. ..E S SDAPTYP=$P(DATA,U,2)
  1. ..D VALSD
  1. .I $P(DATA,U,1)="SCVISIT" D ;SCVISIT is Service Connected? in Query - SCVISIT compared to the patient's SERVICE CONNECTED
  1. ..S TMP=$P(DATA,U,2)
  1. ..S SCVISIT=$S($$UP^XLFSTR(TMP)="FALSE":"NO",$$UP^XLFSTR(TMP)="TRUE":"YES",$$UP^XLFSTR(TMP)="BOTH":"",1:TMP)
  1. .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
  1. ..S TMP=$P(DATA,U,2)
  1. ..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:"")
  1. .I $P(DATA,U,1)="SERVICES" D ;SERVICES are clinic stop pointers to the CLINIC STOP file
  1. ..S TMP=$P(DATA,U,2)
  1. ..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
  1. .I $P(DATA,U,1)="WAITTIME",SDBEG="",SDEND="" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..S SDBEG=$S(TMP["ALL DAYS":"",TMP="<30":"29",TMP="30-60":"60",TMP="60-90":"90",TMP=">=90":"",1:"")
  1. ..S SDEND=$S(TMP["ALL DAYS":"",TMP="<30":"DT",TMP="30-60":"30",TMP="60-90":"60",TMP=">=90":"90",1:"90")
  1. ..D VALID
  1. .I $P(DATA,U,1)="URGENCY" D
  1. ..S TMP=$P(DATA,U,2)
  1. ..F I=1:1:$L(TMP,"~") I $D(^ORD(101,+$P(TMP,"~",I),0)) S URG($P(TMP,"~",I))="",URG=1
  1. ..S:$D(URG)>1 SDAPTYP="C"
  1. I SDAPTYP="" S SDAPTYP="A~E~R~C"
  1. ;
  1. ;Now let's find our patients
  1. 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
  1. 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
  1. S ^TMP("SDECIDX",$J,"MORE")=+MORE
  1. Q
  1. VALID ;validate begin date
  1. S SDBEG=$G(SDBEG)
  1. I SDBEG'="" S %DT="" S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-SDBEG)
  1. I SDBEG="" S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
  1. ;validate end date
  1. S SDEND=$G(SDEND)
  1. I SDEND'="" S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-SDEND)
  1. I SDEND="" S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
  1. Q
  1. VALPT(PTS) ;Validate patients
  1. ;validate DFN
  1. N LP
  1. S LP="" F S LP=$O(PTS(LP)) Q:LP="" D
  1. .I '$D(^DPT(LP,0)) K PTS(LP)
  1. Q
  1. VALSD(SDAPTYP) ;validate SDAPTYP
  1. S SDAPTYP=$G(SDAPTYP)
  1. S:SDAPTYP="" SDAPTYP="ACER"
  1. I "ACER"'[SDAPTYP S @SDECY@(1)="-1^Invalid Request Type." Q
  1. Q
  1. VALPRI(PRI) ;validate PRIGRP
  1. N LP,TMP
  1. S PRI=""
  1. S LP="" F S LP=$O(PRI(LP)) Q:LP="" D
  1. .S TMP=LP
  1. .I TMP="" S TMP="GROUP 0"
  1. .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)
  1. .E S PRI=PRI_$S(PRI'="":"|",1:"")_$E(TMP,7)
  1. Q
  1. DESDTR(DATA) ;validate desired date range and origination date range
  1. N %DT,SDBEG,SDEND,X,Y
  1. S SDBEG=$P(DATA,"~",1)
  1. I SDBEG'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y
  1. I (SDBEG="")!(SDBEG=-1) S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
  1. S SDEND=$P(DATA,"~",2)
  1. I SDEND'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y
  1. I (SDEND="")!(SDEND=-1) S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
  1. Q SDBEG_"~"_SDEND
  1. DESDT(DESDT) ;validate DESDT
  1. N %DT,X,Y
  1. I DESDT'="" S %DT="" S X=$P(DESDT,"@",1) D ^%DT S DESDT=Y
  1. Q DESDT
  1. ORIG(ORIG) ;validate ORIGDT
  1. N %DT,X,Y
  1. I ORIG'="" S %DT="" S X=$P(ORIG,"@",1) D ^%DT S ORIG=Y
  1. Q ORIG
  1. VALCL(CLINIC) ;validate Clinic
  1. N IEN
  1. ;is CLINIC an IEN
  1. I +CLINIC,$D(^SC(CLINIC,0)) Q CLINIC
  1. ;CLINIC is a name
  1. S IEN=""
  1. S IEN=$O(^SC("B",CLINIC,IEN))
  1. I IEN="" S IEN=0
  1. Q IEN
  1. VALFIL(FILTERIN,FILTER) ;validate filters and build FILTER array
  1. N SDC,SDI
  1. K FILTER
  1. S FILTERIN=$G(FILTERIN)
  1. Q:FILTERIN=""
  1. S SDC=0
  1. F SDI=1:1:$L(FILTERIN,"|") D
  1. .S SDC=SDC+1 S FILTER(SDC)=$P(FILTERIN,"|",SDI),FILTER("B",$P($P(FILTERIN,"|",SDI),"^",1),SDC)=$P(FILTERIN,"|",SDI)
  1. Q
  1. VALSORT(SORTIN,SORT) ;validate sorts and build SORT array
  1. N SDC,SDI
  1. K SORT
  1. S SORTIN=$G(SORTIN,"|")
  1. Q:SORTIN=""
  1. S SDC=0
  1. F SDI=1:1:$L(SORTIN,"|") D
  1. .S SDC=SDC+1 S (SORT("B",$P(SORTIN,"|",SDI),SDC),SORT(SDC))=$P(SORTIN,"|",SDI)
  1. Q
  1. IEN(MGIENS) ;build IEN array
  1. N SDI
  1. S MGIENS=$G(MGIENS)
  1. Q:MGIENS=""
  1. F SDI=1:1:$L(MGIENS,"|") D
  1. .S MGIENS($P(MGIENS,"|",SDI))=""
  1. Q
  1. 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. N SDCNT,SDLAST,SDMAX1
  1. S SDCNT=0
  1. 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
  1. S MORE=1
  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)
  1. Q:SDCNT'<SDMAX
  1. 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
  1. Q:SDCNT'<SDMAX
  1. 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)
  1. Q:SDCNT'<SDMAX
  1. 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)
  1. Q:SDCNT'<SDMAX
  1. S MORE=0
  1. Q
  1. 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. N LOOP,DFN,SDCNT,SDLAST,SDMAX1
  1. S SDCNT=0
  1. 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
  1. S LOOP="" F S LOOP=$O(PTS(LOOP)) Q:LOOP="" D
  1. .S DFN=LOOP
  1. .S MORE=1
  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
  1. .Q:SDCNT'<SDMAX
  1. .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)
  1. .Q:SDCNT'<SDMAX
  1. .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)
  1. .Q:SDCNT'<SDMAX
  1. .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)
  1. .Q:SDCNT'<SDMAX
  1. .S MORE=0
  1. Q
  1. GETMORE(DATA,LASTSUB,MAX,MORE) ;
  1. N LP,CNT,NODE
  1. S CNT=0,MAX=$G(MAX),MORE=$G(MORE)
  1. I MAX="" S MAX=25
  1. S DATA=$$TMPGBL
  1. S @DATA@(0)="T00030TYPE^T00030IEN^T00030KEY^T00030TOTAL^T00030MORE"_$C(30)
  1. S LP=LASTSUB F S LP=$O(^TMP("SDECIDX",$J,"XREF",LP)) Q:LP="" D Q:(CNT=MAX)
  1. .S NODE=$G(^TMP("SDECIDX",$J,"XREF",LP))
  1. .S $P(NODE,U,4)=$G(^TMP("SDECIDX",$J,"COUNT"))
  1. .S $P(NODE,U,5)=+$G(^TMP("SDECIDX",$J,"MORE"))
  1. .S CNT=CNT+1
  1. .S @DATA@(CNT)=NODE_$C(30)
  1. S @DATA@(CNT)=$P(@DATA@(CNT),$C(30))_$C(30,31)
  1. Q
  1. ;
  1. TMPGBL() ;EP-
  1. K ^TMP("SDECRMG",$J) Q $NA(^($J))
  1. ;
  1. CALIGN(DATA,SDHDR) ;
  1. N RET,SDI,SDPOS
  1. S RET=""
  1. F SDI=1:1:$L(DATA,U) D
  1. .S SDPOS=SDHDR("C",SDI)
  1. .S $P(RET,U,SDPOS)=$P(DATA,U,SDI)
  1. S $P(RET,U,SDHDR("C","RMGTYPE"))="C"
  1. Q RET
  1. ;
  1. GETNEXT(LASTSUB,MAXREC,SDECY) ;return next set of records
  1. N SD1,SD2,SD3,SD4,SD5,SDECI,SDIDX,SDSUB,SDTMP
  1. S MAXREC=$G(MAXREC,25)
  1. S SDIDX=$P(LASTSUB,"|",1)
  1. S SDSUB=""
  1. S SDECI=0
  1. S @SDECY@(SDECI)=@SDIDX@("HDR")
  1. S SD1=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:"") S $P(LASTSUB,"|",2)=""
  1. F S SD1=$O(@SDIDX@("DATA",SD1)) Q:SD1="" D I SDECI'<MAXREC S $P(SDSUB,"|",2)=SD1 Q
  1. .S SD2=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:"") S $P(LASTSUB,"|",3)=""
  1. .F S SD2=$O(@SDIDX@("DATA",SD1,SD2)) Q:SD2="" D I SDECI'<MAXREC S $P(SDSUB,"|",3)=SD2 Q
  1. ..S SD3=$S($P(LASTSUB,"|",4)'="":$P(LASTSUB,"|",4),1:"") S $P(LASTSUB,"|",4)=""
  1. ..F S SD3=$O(@SDIDX@("DATA",SD1,SD2,SD3)) Q:SD3="" D I SDECI'<MAXREC S $P(SDSUB,"|",4)=SD3 Q
  1. ...S SD4=$S($P(LASTSUB,"|",5)'="":$P(LASTSUB,"|",5),1:"") S $P(LASTSUB,"|",5)=""
  1. ...F S SD4=$O(@SDIDX@("DATA",SD1,SD2,SD3,SD4)) Q:SD4="" D I SDECI'<MAXREC S $P(SDSUB,"|",5)=SD4 Q
  1. ....S SD5=$S($P(LASTSUB,"|",6)'="":$P(LASTSUB,"|",6),1:"") S $P(LASTSUB,"|",6)=""
  1. ....F S SD5=$O(@SDIDX@("DATA",SD1,SD2,SD3,SD4,SD5)) Q:SD5="" D I SDECI'<MAXREC S $P(SDSUB,"|",6)=SD5 Q
  1. .....S SDECI=SDECI+1 S @SDECY@(SDECI)=@SDIDX@("DATA",SD1,SD2,SD3,SD4,SD5)_$C(30)
  1. I SDSUB="" K @SDIDX
  1. I SDSUB'="" D
  1. .S $P(SDSUB,"|",1)=SDIDX
  1. .S SDTMP=@SDECY@(SDECI)
  1. .S SDTMP=$P(SDTMP,$C(30),1)
  1. .S $P(SDTMP,U,@SDIDX@("LASTSUB"))=SDSUB
  1. .S @SDECY@(SDECI)=SDTMP_$C(30)
  1. S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1. Q
  1. ;
  1. SFILTER(FILTERS,FILTER1,FILVAL) ;set/change existing filter value
  1. N FILD
  1. S FILD="" F S FILD=$O(^FILTERS("B",FILTER1,FILD)) Q:FILD="" D
  1. .S $P(FILTERS(FILD),"^",2)=FILVAL
  1. Q