SDCED1 ;ALB/JCH - VSE ENCOUNTER XREF ; 19 Oct 14 04:11PM
;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
;;
Q
;
EN(SDRPTAR,SDBEGRNG,SDENDRNG,SDNODE) ;
;; This utility will build a cross reference for the ENCOUNTER (#409.68) file
;; that will contain all encounters for a provider, by date ( PROVIDER,DATE,ENCOUNTER )
;; and a cross reference that will contain all encounters for a facility, by date
;; ( LOCATION, DATE, ENCOUNTER)
;
N SDFAC,DATE,DT,SDWEEKS,SDATE,SDLCNT,SDRPT,SDBEGDT,SDENDDT,SDSTART
S DT=$$NOW^XLFDT,SDATE=DT
S SDATE=$O(^XTMP("SDVSE","DT","")) Q:'SDATE
S SDSTART=$$FMADD^XLFDT(SDATE,-365)
S SDFAC=+$$SITE^VASITE()
S SDBEGRNG=$G(SDBEGRNG),SDENDRNG=$G(SDENDRNG)
I ($G(SDBEGRNG)&$G(SDENDRNG)) S SDBEGDT=$P(SDBEGRNG,".")
S SDENDATE=$S($G(SDBEGDT):$P(SDENDRNG,".")_".24",1:"")
I $G(SDENDATE),$G(SDBEGDT) S DTRANGE=$P(SDBEGDT,".")_"-"_$P(SDENDATE,".")
;
S SDNODE=$S($G(DTRANGE):$J_",SDCEX",1:"SDCEX")
I $G(^XTMP(SDNODE,0))=$G(^XTMP("SDVSE",0)) Q
K ^XTMP(SDNODE) S ^XTMP(SDNODE,0)=^XTMP("SDVSE",0)
D WEEKS(SDSTART,.SDWEEKS)
D PROVIDER(SDBEGRNG,SDENDRNG,$G(DTRANGE),SDNODE)
D AGGDT(SDBEGRNG,SDENDRNG,$G(DTRANGE),SDNODE)
D CLEAN(SDNODE)
Q
;
PROVIDER(SDBEGRNG,SDENDRNG,DTRANGE,SDNODE) ; aggregate daily encounters by provider
N SDENC,SDEST,SDNEW,TELCATD,DIVEX,CLINEX,PROVEX,SDEFLT
N SDIV,SDEC,SDCL,SDPR,SDACTDT,SDIV,SDGRP,AGGDATA,SDVSEBEG
;
S SDEST=0,SDNEW=0,SDDT=0
S SDEFLT=$$FMADD^XLFDT($$NOW^XLFDT,-366)
;
S SDACTDT=$O(^XTMP("SDVSE","DT","")) Q:'SDACTDT
S SDRPTYP="" F S SDRPTYP=$O(SDRPTAR(SDRPTYP)) Q:SDRPTYP="" D
.S SDCL=0 F S SDCL=$O(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL)) Q:'SDCL D
..S SDIV=$$GETDIV(SDCL)
..S SDDT=$S($G(DTRANGE):+DTRANGE,1:SDEFLT),SDDT=$$FMADD^XLFDT(SDDT,,,-1)
..F S SDDT=$O(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT)) Q:'SDDT!($G(DTRANGE)&($P(SDDT,".")>$P(DTRANGE,"-",2))) D
...S SDPR="" F S SDPR=$O(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT,SDPR)) Q:SDPR="" D
....D ENCOUNTR(SDACTDT,SDRPTYP,SDFAC,SDIV,SDCL,SDDT,SDPR,$G(DTRANGE),SDNODE)
....D APPT(SDACTDT,SDRPTYP,SDFAC,SDIV,SDCL,SDDT,SDPR,$G(DTRANGE),SDNODE)
...N SUPPLY S SUPPLY=$G(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT,0,"APP","SUP"))
...Q:'SUPPLY
...D SUPPLY(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDCL,SUPPLY)
Q
;
ENCOUNTR(SDACTDT,SDRPTYP,SDFAC,SDIV,SDCL,SDDT,SDPR,DTRANGE,SDNODE) ; Get encounters from ^XTMP("SDVSE","DT"
Q:'SDPR ; Encounters must have a provider
N SDUTLND,SVCAT,SDGRP,PRVNAM,CLNAM,STOPIEN,STOPGRP,SDEDDT,SDTEL
S SDEDDT=SDDT
S SDUTLND=$G(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDEDDT,SDPR,"ENC"))
Q:SDUTLND=""
S SDENC=$P(SDUTLND,"^"),SDNEW=$P(SDUTLND,"^",2),SDEST=$P(SDUTLND,"^",3),SDTEL=$P(SDUTLND,"^",4)
;S SDGRP=$P($G(^SC(+SDCL,0)),"^",7)
D SDGRP^SDECXUTL(+SDCL,.SDGRP)
; Aggregate daily provider total
I $G(DTRANGE) S SDEDDT=DTRANGE
S PRVNAM=$P($G(^VA(200,+SDPR,0)),"^")
S CLNAM=$P($G(^SC(+SDCL,0)),"^")
N SDTMPND S SDTMPND=$G(^XTMP(SDNODE,"Date",SDRPTYP,$P(SDEDDT,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR))
S AGGDATA="" N I F I=1:1:$L(SDUTLND,"^") D
.S $P(AGGDATA,"^",I)=$P(SDUTLND,"^",I)+$P(SDTMPND,"^",I)
S ^XTMP(SDNODE,"Date",SDRPTYP,$P(SDEDDT,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR)=AGGDATA
;
N SDTMPND S SDTMPND=$G(^XTMP(SDNODE,"Date",SDRPTYP,$P(SDEDDT,"."),SDFAC,SDIV,0,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR))
S AGGDATA="" N I F I=1:1:$L(SDUTLND,"^") D
.S $P(AGGDATA,"^",I)=$P(SDUTLND,"^",I)+$P(SDTMPND,"^",I)
S PRVNAM=$P($G(^VA(200,+SDPR,0)),"^")
S ^XTMP(SDNODE,"Date",SDRPTYP,$P(SDEDDT,"."),SDFAC,SDIV,0,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR)=AGGDATA
Q
;
APPT(SDACTDT,SDRPTYP,SDFAC,SDIV,SDCL,SDDT,SDPAT,DTRANGE,SDNODE) ; Get appointments from ^XTMP("SDVSE","DT"
N SDUTLND,SDPR,SDTMPND,SDGRP,AGGDATA,LEN,STATUS,STOPIEN,STOPGRP
S SDPR="" F S SDPR=$O(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT,SDPAT,"APPT",SDPR)) Q:SDPR="" D
.S SDUTLND=$G(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT,SDPAT,"APPT",SDPR))
.Q:SDUTLND=""
.; Aggregate the total of all groups, and each group
.D APPTG
Q
;
APPTG ; Add data to groups "All" and SDGRP
N PRVNAM,SDDATE,CLNAM,TMPGRP,SDGRP
S PRVNAM=$S($G(SDPR):$P($G(^VA(200,+SDPR,0)),"^"),1:" None")
S SDDATE=$S($G(DTRANGE):DTRANGE,1:SDDT)
S CLNAM=$P($G(^SC(+$G(SDCL),0)),"^")
D SDGRP^SDECXUTL(+SDCL,.TMPGRP)
S SDGRP=TMPGRP
;
; Aggregate Overbooks^New^Established
S LEN=$P(SDUTLND,"^",4),STATUS=$P(SDUTLND,"^",5)
I 'LEN S LEN=$$APPLEN^SDCED2($G(SDCL))
Q:'$G(LEN)
;
; Appointment Lengths specific ResourceGroup
S AGGDATA=""
S SDTMPND=$G(^XTMP(SDNODE,"Date",SDRPTYP,$P(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR,"APP","LEN",LEN,TMPGRP))
S AGGDATA=$P(SDTMPND,"^")+LEN
; Continued
N I F I=1:1:3 D
.S $P(AGGDATA,"^",I+1)=$P(SDUTLND,"^",I)+$P(SDTMPND,"^",I+1)
S ^XTMP(SDNODE,"Date",SDRPTYP,$P(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR,"APP","LEN",LEN,TMPGRP)=AGGDATA
;
; Appointment Status, Specific ResourceGroup
S SDTMPND=$G(^XTMP(SDNODE,"Date",SDRPTYP,$P(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR,"APP","LEN",LEN,"STAT",STATUS))
S SDTMPND=SDTMPND+1
S ^XTMP(SDNODE,"Date",SDRPTYP,$P(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR,"APP","LEN",LEN,"STAT",STATUS)=SDTMPND
;
Q
;
CLEAN(SDNODE) ; Clean up
Q
;
CHKEST(DFN,BDATE,ENC,CLSTOP) ; Was Patient DFN's encounter on date DATE considered Established or New?
N OLOC,SDLOC,OENCND,SDCHIT,PRVDATE,PRVENC,OCLSTOP S PRVDATE=BDATE,PRVENC=ENC
Q:'$G(DFN) "" Q:'$G(BDATE) "" Q:'$G(ENC) "" Q:'$D(^SCE(ENC,0)) ""
S SDLOC=$P($G(^SCE(ENC,0)),"^",4),CLSTOP=""
D CLSTOP(SDLOC,.CLSTOP) I 'CLSTOP S CLSTOP=$P($G(^SCE(ENC,0)),"^",3) Q:'CLSTOP ""
S SDCHIT=0
F Q:$G(SDCHIT) S PRVDATE=$O(^SCE("ADFN",DFN,PRVDATE),-1) Q:'PRVDATE!($$FMDIFF^XLFDT(BDATE,PRVDATE)>730) S PRVENC=0 F S PRVENC=$O(^SCE("ADFN",DFN,PRVDATE,PRVENC)) Q:'PRVENC!$G(SDCHIT) D
.S OENCND=$G(^SCE(PRVENC,0)) S OCLSTOP="",OLOC=$P(OENCND,"^",4)
.D CLSTOP(OLOC,.OCLSTOP) S:'$G(OCLSTOP) OCLSTOP=$P(OENCND,"^",3)
.I OCLSTOP=CLSTOP S SDCHIT=$P(^SCE(ENC,0),"^",4)
Q $S($G(SDCHIT):$G(SDCHIT),1:0)
;
GETSCAT(SDLOC,SDSGNM,SDSGAR) ; Get Stop Code Group Name
N CSTOP S CSTOP="",SDSGNM="UNKNOWN"
D CLSTOP(SDLOC,.CSTOP)
I $G(CSTOP) D STOPCAT(CSTOP,.SDSGNM,.SDSGAR)
Q
;
CLSTOP(SDLOC,CSTOP) ; Get Clinic Stop
N SDCS K CSTOP S CSTOP=""
S CSTOP=$P(^SC(SDLOC,0),U,7)
Q:'CSTOP
; Get AMIS REPORTING STOP CODE
S CSTOP=$P(^DIC(40.7,CSTOP,0),U,2)
Q
STOPCAT(CLSTOP,CAT,STOPAR) ; Get stop code category (Mental Health, Specialty, Primary)
N CLINEX,STPCNT,OK,TMPCAT,FOUND S FOUND=0
Q:'$G(CLSTOP) K CAT S TMPCAT="UNKNOWN"
S STPCNT="" F S STPCNT=$O(STOPAR(STPCNT)) Q:(STPCNT="")!$G(FOUND) D
.S CLINEX="" F S CLINEX=$O(STOPAR(STPCNT,CLINEX)) Q:CLINEX=""!$G(FOUND) D
..I +$P($G(STOPAR(STPCNT,CLINEX)),"^",2)=+CLSTOP S FOUND=CLSTOP
..S TMPCAT=STPCNT
S CAT=$S(TMPCAT="S":"SPECIALTY CARE",TMPCAT="M":"MENTAL HEALTH",TMPCAT="P":"PRIMARY CARE",1:"UNKNOWN")
Q
;
DIV(DIVINT) ; convert internal division to external
N DIC,DA,DR,DIVAR,DIVXAR
S DIC=40.8,DA=DIVINT,DR=".01"
D GETS^DIQ(DIC,DA,DR,"E","DIVXAR")
S DIVEX=$G(DIVXAR(40.8,DIVINT_",",.01,"E"))
I DIVEX=""!($L(DIVEX)<3) S DIVEX=$P($$SITE^VASITE,"^",2)
Q DIVEX
;
WEEKS(SDDT,WEEKS) ; Get ending dates for 52 weeks
N TODAY,NEXTD,STARTD,NEXTW K WEEKS S WEEKS="",STARTD=""
S TODAY=$$DOW^XLFDT(SDDT) I TODAY="Sunday" S STARTD=SDDT
I TODAY'="Sunday" F I=1:1:6 D Q:$G(STARTD)
.S NEXTD=$$FMADD^XLFDT(SDDT,I) I $$DOW^XLFDT(NEXTD)="Sunday" S STARTD=NEXTD
F I=1:1:53 S NEXTW=$P($$FMADD^XLFDT(STARTD,I*7),".") S WEEKS(NEXTW)=NEXTW
Q
;
GETDIV(CLINIC) ; Return CLINIC's division from file 40.8
N DIC,DA,DR,CLINAR
Q:'$G(CLINIC) ""
S DIQ(0)="I",DIC=44,DA=CLINIC,DR="3.5"
D GETS^DIQ(DIC,+DA,DR,"I","CLINAR")
S SDIV=$G(CLINAR(44,CLINIC_",",3.5,"I"))
I '(SDIV>0) S SDIV=$P($$SITE^VASITE,"^",2)
Q SDIV
;
AGGDT(SDBEGRNG,SDENDRNG,DTRANGE,SDNODE) ; Aggregate Facility, Divisions, Clinics, Providers by Date
N SDFAC,SDIV,SDRPTYP,SDCL,SDPRV,SDDT,SDDTAG,SDENDATE,SDPRVND
N TMPWK,TMPMON,TMPQRT,TMPYR,AGGDATA
S SDRPTYP="" F S SDRPTYP=$O(^XTMP(SDNODE,"Date",SDRPTYP)) Q:SDRPTYP="" D
.S SDDT=0 F S SDDT=$O(^XTMP(SDNODE,"Date",SDRPTYP,SDDT)) Q:'SDDT D
..S TMPMON=$E(SDDT,1,5)_"00"
..I '$G(TMPYR) S TMPYR=$E(SDDT,1,3)_"0000"
..S TMPWK=$$GETWEEK(SDDT,.SDWEEKS)
..S TMPQRT=$$GETQUART(SDDT)
..S SDFAC="" F S SDFAC=$O(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC)) Q:SDFAC="" D
...S SDIV="" F S SDIV=$O(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV)) Q:'SDIV D
....;Q:SDIV="APP"
....S SDGRP="" F S SDGRP=$O(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP)) Q:SDGRP="" D
.....Q:SDGRP="APP" Q:(SDGRP=0)
.....S SDCL="" F S SDCL=$O(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL)) Q:SDCL="" D
......Q:SDCL="APP" D SUP^SDCED2
......S SDPRV="" F S SDPRV=$O(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL,SDPRV)) Q:SDPRV="" D
.......Q:(SDPRV'["^")
.......;
.......; Appointments
.......D APPT^SDCED2(SDNODE,SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL,SDPRV,DTRANGE,TMPMON,TMPQRT,TMPYR,.SDWEEKS)
.......;
.......; Get smallest encounter aggregation
.......S SDPRVND=$G(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL,SDPRV))
.......Q:SDPRVND=""
.......;
.......; Add daily provider aggregation to Group
.......D AGGSET("^XTMP(SDNODE,""Date"",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP)","Date",SDPRVND)
.......;
.......; Add daily provider aggregation to appropriate Clinic
.......D AGGSET("^XTMP(SDNODE,""Date"",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL)","Date",SDPRVND)
.......;
.......N DTNAM,TOT1,TOT2,TOT3,TOT4,SDGLROOT,SDGLFULL
.......I '($G(SDBEGRNG)&$G(SDENDRNG)) S SDGLROOT="^XTMP(SDNODE,DTNAM,SDRPTYP,TMPDT,SDFAC" D
........; Aggregate Annual, Quarterly, Monthly, Weekly Group, Division, Clinic, Provider
........F DTNAM="Year","Month","Week","Quarter" D
.........F SDGLFULL=SDGLROOT_")",SDGLROOT_",SDIV)",SDGLROOT_",SDIV,SDGRP)",SDGLROOT_",SDIV,SDGRP,SDCL)",SDGLROOT_",SDIV,SDGRP,SDCL,SDPRV)" D
..........; Don't add each group to facility and division totals - already done with group 0 (all)
..........;I SDGRP Q:(SDGLFULL[",SDIV)")!(SDGLFULL[",SDFAC)")
..........I SDGRP Q:'(SDGLFULL["SDGRP")
..........D AGGSET(SDGLFULL,DTNAM,SDPRVND)
.......;
.......; Resource Group Specific aggregations (Annual, Quarterly, Monthly, Weekly, Daily)
.......S SDGLROOT="^XTMP(SDNODE,""GROUP"",DTNAM,SDRPTYP,TMPDT" D
........F DTNAM="Year","Quarter","Month","Week","Date" D
.........I $G(SDBEGRNG)&$G(SDENDRNG) Q:'(DTNAM="Date")
.........S SDGLFULL=SDGLROOT_",SDFAC,SDGRP)" D AGGSET(SDGLFULL,DTNAM,SDPRVND)
.........S SDGLFULL=SDGLROOT_",SDFAC,SDGRP,""CLIN"",SDCL)" D AGGSET(SDGLFULL,DTNAM,SDPRVND)
.......;
.......; Provider Specific aggregations (Annual, Quarterly, Monthly, Weekly, Daily)
.......S SDGLROOT="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT"
.......F DTNAM="Year","Quarter","Month","Week","Date" D
........I $G(SDBEGRNG)&$G(SDENDRNG) Q:'(DTNAM="Date")
........S SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""FAC"",SDFAC,SDPRV)" D AGGSET(SDGLFULL,DTNAM,SDPRVND)
........S SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""FAC"",SDFAC,""CLIN"",SDCL,""PROV"",SDPRV)" D AGGSET(SDGLFULL,DTNAM,SDPRVND)
........S SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""DIV"",SDIV,SDPRV)" D AGGSET(SDGLFULL,DTNAM,SDPRVND)
........S SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""DIV"",SDIV,""CLIN"",SDCL,SDPRV)" D AGGSET(SDGLFULL,DTNAM,SDPRVND)
........S SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""GRP"",SDGRP,SDPRV)" D AGGSET(SDGLFULL,DTNAM,SDPRVND)
........S SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,"_SDIV_",""GRP"",SDGRP,SDPRV)" D AGGSET(SDGLFULL,DTNAM,SDPRVND)
........;
........; Don't add each group to facility and division totals - already done with group 0 (all)
........; Add daily provider aggregation to division
........Q:($G(SDGRP)=0)
........D AGGSET("^XTMP(SDNODE,DTNAM,SDRPTYP,TMPDT,SDFAC,SDIV)",DTNAM,SDPRVND)
........;
........; Add daily provider aggregation to facility
........D AGGSET("^XTMP(SDNODE,DTNAM,SDRPTYP,TMPDT,SDFAC)",DTNAM,SDPRVND)
Q
;
AGGSET(SDGLOB,DTNAM,PRVND) ; Perform generic aggregation of Pn values into SDGLOB
; Encounter data stored in @SDGLOB
N I,TMPDT,TOT,AGGDATA
S TMPDT=$S(DTNAM="Year":TMPYR,DTNAM="Quarter":TMPQRT,DTNAM="Month":TMPMON,DTNAM="Week":TMPWK,1:SDDT)
S TOT=$G(@(SDGLOB))
F I=1:1:$L(PRVND,"^") S $P(AGGDATA,"^",I)=($P(TOT,"^",I)+$P(PRVND,"^",I))
S @(SDGLOB)=AGGDATA
Q
;
GRP(LOC,GROUP) ; Get clinic groups
; Look in Clinic Group for now, until Medsphere code is available
K GROUP S GROUP=""
N LOCNUM,DIC,X,Y S DIC=44,DIC(0)="MZ",X=LOC D ^DIC Q:(Y<1) S LOCNUM=+Y
N CGRP S CGRP=0 F S CGRP=$O(^PS(57.8,"AC",LOCNUM,CGRP)) Q:'CGRP D
.S GROUP(LOC,CGRP)=$P($G(^PS(57.8,+CGRP,0)),"^")
Q
;
GETWEEK(SDDT,SDWEEKS) ; Return the week-ending date for date SDDT
K TMPWK
S TMPWK=$G(SDWEEKS($P(SDDT,"."))) I 'TMPWK S TMPWK=$P($O(SDWEEKS(SDDT)),".") I TMPWK["."
S TMPWK=$$FMADD^XLFDT(TMPWK,-1)
Q TMPWK
;
GETQUART(SDDT) ; Return quarter
K SDQUART N MONTH,YEAR
S YEAR=$$FMTE^XLFDT($E(SDDT,1,3)_"0000")
S MONTH=$E(SDDT,4,5)
S SDQUART=$S(MONTH<4:"Q1",MONTH<7:"Q2",MONTH<10:"Q3",MONTH<13:"Q4",1:"Q0")
;S SDQUART=SDQUART_"-"_YEAR
S SDQUART=YEAR_"-"_SDQUART
Q SDQUART
;
SUPPLY(SDNODE,DTINC,SDRPTYP,SDDT,SDFAC,SDIV,SDCL,SUPPLY) ; Get Supply
Q:'SUPPLY
N SDDATE,SDGRP,TMPSUP,CLNAM
D SDGRP^SDECXUTL(+SDCL,.SDGRP)
S SDDATE=$S($G(DTRANGE):DTRANGE,1:SDDT)
S CLNAM=$S($G(SDCL):$P($G(^SC(+SDCL,0)),"^"),1:$P(SDCL,"^"))
;
S TMPSUP=$G(^XTMP(SDNODE,DTINC,SDRPTYP,$P(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,"APP","SUP"))
S TMPSUP=TMPSUP+SUPPLY
S ^XTMP(SDNODE,DTINC,SDRPTYP,$P(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,"APP","SUP")=TMPSUP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCED1 14028 printed Sep 23, 2025@20:25:23 Page 2
SDCED1 ;ALB/JCH - VSE ENCOUNTER XREF ; 19 Oct 14 04:11PM
+1 ;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
+2 ;;
+3 QUIT
+4 ;
EN(SDRPTAR,SDBEGRNG,SDENDRNG,SDNODE) ;
+1 ;; This utility will build a cross reference for the ENCOUNTER (#409.68) file
+2 ;; that will contain all encounters for a provider, by date ( PROVIDER,DATE,ENCOUNTER )
+3 ;; and a cross reference that will contain all encounters for a facility, by date
+4 ;; ( LOCATION, DATE, ENCOUNTER)
+5 ;
+6 NEW SDFAC,DATE,DT,SDWEEKS,SDATE,SDLCNT,SDRPT,SDBEGDT,SDENDDT,SDSTART
+7 SET DT=$$NOW^XLFDT
SET SDATE=DT
+8 SET SDATE=$ORDER(^XTMP("SDVSE","DT",""))
if 'SDATE
QUIT
+9 SET SDSTART=$$FMADD^XLFDT(SDATE,-365)
+10 SET SDFAC=+$$SITE^VASITE()
+11 SET SDBEGRNG=$GET(SDBEGRNG)
SET SDENDRNG=$GET(SDENDRNG)
+12 IF ($GET(SDBEGRNG)&$GET(SDENDRNG))
SET SDBEGDT=$PIECE(SDBEGRNG,".")
+13 SET SDENDATE=$SELECT($GET(SDBEGDT):$PIECE(SDENDRNG,".")_".24",1:"")
+14 IF $GET(SDENDATE)
IF $GET(SDBEGDT)
SET DTRANGE=$PIECE(SDBEGDT,".")_"-"_$PIECE(SDENDATE,".")
+15 ;
+16 SET SDNODE=$SELECT($GET(DTRANGE):$JOB_",SDCEX",1:"SDCEX")
+17 IF $GET(^XTMP(SDNODE,0))=$GET(^XTMP("SDVSE",0))
QUIT
+18 KILL ^XTMP(SDNODE)
SET ^XTMP(SDNODE,0)=^XTMP("SDVSE",0)
+19 DO WEEKS(SDSTART,.SDWEEKS)
+20 DO PROVIDER(SDBEGRNG,SDENDRNG,$GET(DTRANGE),SDNODE)
+21 DO AGGDT(SDBEGRNG,SDENDRNG,$GET(DTRANGE),SDNODE)
+22 DO CLEAN(SDNODE)
+23 QUIT
+24 ;
PROVIDER(SDBEGRNG,SDENDRNG,DTRANGE,SDNODE) ; aggregate daily encounters by provider
+1 NEW SDENC,SDEST,SDNEW,TELCATD,DIVEX,CLINEX,PROVEX,SDEFLT
+2 NEW SDIV,SDEC,SDCL,SDPR,SDACTDT,SDIV,SDGRP,AGGDATA,SDVSEBEG
+3 ;
+4 SET SDEST=0
SET SDNEW=0
SET SDDT=0
+5 SET SDEFLT=$$FMADD^XLFDT($$NOW^XLFDT,-366)
+6 ;
+7 SET SDACTDT=$ORDER(^XTMP("SDVSE","DT",""))
if 'SDACTDT
QUIT
+8 SET SDRPTYP=""
FOR
SET SDRPTYP=$ORDER(SDRPTAR(SDRPTYP))
if SDRPTYP=""
QUIT
Begin DoDot:1
+9 SET SDCL=0
FOR
SET SDCL=$ORDER(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL))
if 'SDCL
QUIT
Begin DoDot:2
+10 SET SDIV=$$GETDIV(SDCL)
+11 SET SDDT=$SELECT($GET(DTRANGE):+DTRANGE,1:SDEFLT)
SET SDDT=$$FMADD^XLFDT(SDDT,,,-1)
+12 FOR
SET SDDT=$ORDER(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT))
if 'SDDT!($GET(DTRANGE)&($PIECE(SDDT,".")>$PIECE(DTRANGE,"-",2)))
QUIT
Begin DoDot:3
+13 SET SDPR=""
FOR
SET SDPR=$ORDER(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT,SDPR))
if SDPR=""
QUIT
Begin DoDot:4
+14 DO ENCOUNTR(SDACTDT,SDRPTYP,SDFAC,SDIV,SDCL,SDDT,SDPR,$GET(DTRANGE),SDNODE)
+15 DO APPT(SDACTDT,SDRPTYP,SDFAC,SDIV,SDCL,SDDT,SDPR,$GET(DTRANGE),SDNODE)
End DoDot:4
+16 NEW SUPPLY
SET SUPPLY=$GET(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT,0,"APP","SUP"))
+17 if 'SUPPLY
QUIT
+18 DO SUPPLY(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDCL,SUPPLY)
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
ENCOUNTR(SDACTDT,SDRPTYP,SDFAC,SDIV,SDCL,SDDT,SDPR,DTRANGE,SDNODE) ; Get encounters from ^XTMP("SDVSE","DT"
+1 ; Encounters must have a provider
if 'SDPR
QUIT
+2 NEW SDUTLND,SVCAT,SDGRP,PRVNAM,CLNAM,STOPIEN,STOPGRP,SDEDDT,SDTEL
+3 SET SDEDDT=SDDT
+4 SET SDUTLND=$GET(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDEDDT,SDPR,"ENC"))
+5 if SDUTLND=""
QUIT
+6 SET SDENC=$PIECE(SDUTLND,"^")
SET SDNEW=$PIECE(SDUTLND,"^",2)
SET SDEST=$PIECE(SDUTLND,"^",3)
SET SDTEL=$PIECE(SDUTLND,"^",4)
+7 ;S SDGRP=$P($G(^SC(+SDCL,0)),"^",7)
+8 DO SDGRP^SDECXUTL(+SDCL,.SDGRP)
+9 ; Aggregate daily provider total
+10 IF $GET(DTRANGE)
SET SDEDDT=DTRANGE
+11 SET PRVNAM=$PIECE($GET(^VA(200,+SDPR,0)),"^")
+12 SET CLNAM=$PIECE($GET(^SC(+SDCL,0)),"^")
+13 NEW SDTMPND
SET SDTMPND=$GET(^XTMP(SDNODE,"Date",SDRPTYP,$PIECE(SDEDDT,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR))
+14 SET AGGDATA=""
NEW I
FOR I=1:1:$LENGTH(SDUTLND,"^")
Begin DoDot:1
+15 SET $PIECE(AGGDATA,"^",I)=$PIECE(SDUTLND,"^",I)+$PIECE(SDTMPND,"^",I)
End DoDot:1
+16 SET ^XTMP(SDNODE,"Date",SDRPTYP,$PIECE(SDEDDT,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR)=AGGDATA
+17 ;
+18 NEW SDTMPND
SET SDTMPND=$GET(^XTMP(SDNODE,"Date",SDRPTYP,$PIECE(SDEDDT,"."),SDFAC,SDIV,0,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR))
+19 SET AGGDATA=""
NEW I
FOR I=1:1:$LENGTH(SDUTLND,"^")
Begin DoDot:1
+20 SET $PIECE(AGGDATA,"^",I)=$PIECE(SDUTLND,"^",I)+$PIECE(SDTMPND,"^",I)
End DoDot:1
+21 SET PRVNAM=$PIECE($GET(^VA(200,+SDPR,0)),"^")
+22 SET ^XTMP(SDNODE,"Date",SDRPTYP,$PIECE(SDEDDT,"."),SDFAC,SDIV,0,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR)=AGGDATA
+23 QUIT
+24 ;
APPT(SDACTDT,SDRPTYP,SDFAC,SDIV,SDCL,SDDT,SDPAT,DTRANGE,SDNODE) ; Get appointments from ^XTMP("SDVSE","DT"
+1 NEW SDUTLND,SDPR,SDTMPND,SDGRP,AGGDATA,LEN,STATUS,STOPIEN,STOPGRP
+2 SET SDPR=""
FOR
SET SDPR=$ORDER(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT,SDPAT,"APPT",SDPR))
if SDPR=""
QUIT
Begin DoDot:1
+3 SET SDUTLND=$GET(^XTMP("SDVSE","DT",SDACTDT,SDRPTYP,SDCL,SDDT,SDPAT,"APPT",SDPR))
+4 if SDUTLND=""
QUIT
+5 ; Aggregate the total of all groups, and each group
+6 DO APPTG
End DoDot:1
+7 QUIT
+8 ;
APPTG ; Add data to groups "All" and SDGRP
+1 NEW PRVNAM,SDDATE,CLNAM,TMPGRP,SDGRP
+2 SET PRVNAM=$SELECT($GET(SDPR):$PIECE($GET(^VA(200,+SDPR,0)),"^"),1:" None")
+3 SET SDDATE=$SELECT($GET(DTRANGE):DTRANGE,1:SDDT)
+4 SET CLNAM=$PIECE($GET(^SC(+$GET(SDCL),0)),"^")
+5 DO SDGRP^SDECXUTL(+SDCL,.TMPGRP)
+6 SET SDGRP=TMPGRP
+7 ;
+8 ; Aggregate Overbooks^New^Established
+9 SET LEN=$PIECE(SDUTLND,"^",4)
SET STATUS=$PIECE(SDUTLND,"^",5)
+10 IF 'LEN
SET LEN=$$APPLEN^SDCED2($GET(SDCL))
+11 if '$GET(LEN)
QUIT
+12 ;
+13 ; Appointment Lengths specific ResourceGroup
+14 SET AGGDATA=""
+15 SET SDTMPND=$GET(^XTMP(SDNODE,"Date",SDRPTYP,$PIECE(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR,"APP","LEN",LEN,TMPGRP))
+16 SET AGGDATA=$PIECE(SDTMPND,"^")+LEN
+17 ; Continued
+18 NEW I
FOR I=1:1:3
Begin DoDot:1
+19 SET $PIECE(AGGDATA,"^",I+1)=$PIECE(SDUTLND,"^",I)+$PIECE(SDTMPND,"^",I+1)
End DoDot:1
+20 SET ^XTMP(SDNODE,"Date",SDRPTYP,$PIECE(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR,"APP","LEN",LEN,TMPGRP)=AGGDATA
+21 ;
+22 ; Appointment Status, Specific ResourceGroup
+23 SET SDTMPND=$GET(^XTMP(SDNODE,"Date",SDRPTYP,$PIECE(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR,"APP","LEN",LEN,"STAT",STATUS))
+24 SET SDTMPND=SDTMPND+1
+25 SET ^XTMP(SDNODE,"Date",SDRPTYP,$PIECE(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,PRVNAM_"^"_SDPR,"APP","LEN",LEN,"STAT",STATUS)=SDTMPND
+26 ;
+27 QUIT
+28 ;
CLEAN(SDNODE) ; Clean up
+1 QUIT
+2 ;
CHKEST(DFN,BDATE,ENC,CLSTOP) ; Was Patient DFN's encounter on date DATE considered Established or New?
+1 NEW OLOC,SDLOC,OENCND,SDCHIT,PRVDATE,PRVENC,OCLSTOP
SET PRVDATE=BDATE
SET PRVENC=ENC
+2 if '$GET(DFN)
QUIT ""
if '$GET(BDATE)
QUIT ""
if '$GET(ENC)
QUIT ""
if '$DATA(^SCE(ENC,0))
QUIT ""
+3 SET SDLOC=$PIECE($GET(^SCE(ENC,0)),"^",4)
SET CLSTOP=""
+4 DO CLSTOP(SDLOC,.CLSTOP)
IF 'CLSTOP
SET CLSTOP=$PIECE($GET(^SCE(ENC,0)),"^",3)
if 'CLSTOP
QUIT ""
+5 SET SDCHIT=0
+6 FOR
if $GET(SDCHIT)
QUIT
SET PRVDATE=$ORDER(^SCE("ADFN",DFN,PRVDATE),-1)
if 'PRVDATE!($$FMDIFF^XLFDT(BDATE,PRVDATE)>730)
QUIT
SET PRVENC=0
FOR
SET PRVENC=$ORDER(^SCE("ADFN",DFN,PRVDATE,PRVENC))
if 'PRVENC!$GET(SDCHIT)
QUIT
Begin DoDot:1
+7 SET OENCND=$GET(^SCE(PRVENC,0))
SET OCLSTOP=""
SET OLOC=$PIECE(OENCND,"^",4)
+8 DO CLSTOP(OLOC,.OCLSTOP)
if '$GET(OCLSTOP)
SET OCLSTOP=$PIECE(OENCND,"^",3)
+9 IF OCLSTOP=CLSTOP
SET SDCHIT=$PIECE(^SCE(ENC,0),"^",4)
End DoDot:1
+10 QUIT $SELECT($GET(SDCHIT):$GET(SDCHIT),1:0)
+11 ;
GETSCAT(SDLOC,SDSGNM,SDSGAR) ; Get Stop Code Group Name
+1 NEW CSTOP
SET CSTOP=""
SET SDSGNM="UNKNOWN"
+2 DO CLSTOP(SDLOC,.CSTOP)
+3 IF $GET(CSTOP)
DO STOPCAT(CSTOP,.SDSGNM,.SDSGAR)
+4 QUIT
+5 ;
CLSTOP(SDLOC,CSTOP) ; Get Clinic Stop
+1 NEW SDCS
KILL CSTOP
SET CSTOP=""
+2 SET CSTOP=$PIECE(^SC(SDLOC,0),U,7)
+3 if 'CSTOP
QUIT
+4 ; Get AMIS REPORTING STOP CODE
+5 SET CSTOP=$PIECE(^DIC(40.7,CSTOP,0),U,2)
+6 QUIT
STOPCAT(CLSTOP,CAT,STOPAR) ; Get stop code category (Mental Health, Specialty, Primary)
+1 NEW CLINEX,STPCNT,OK,TMPCAT,FOUND
SET FOUND=0
+2 if '$GET(CLSTOP)
QUIT
KILL CAT
SET TMPCAT="UNKNOWN"
+3 SET STPCNT=""
FOR
SET STPCNT=$ORDER(STOPAR(STPCNT))
if (STPCNT="")!$GET(FOUND)
QUIT
Begin DoDot:1
+4 SET CLINEX=""
FOR
SET CLINEX=$ORDER(STOPAR(STPCNT,CLINEX))
if CLINEX=""!$GET(FOUND)
QUIT
Begin DoDot:2
+5 IF +$PIECE($GET(STOPAR(STPCNT,CLINEX)),"^",2)=+CLSTOP
SET FOUND=CLSTOP
+6 SET TMPCAT=STPCNT
End DoDot:2
End DoDot:1
+7 SET CAT=$SELECT(TMPCAT="S":"SPECIALTY CARE",TMPCAT="M":"MENTAL HEALTH",TMPCAT="P":"PRIMARY CARE",1:"UNKNOWN")
+8 QUIT
+9 ;
DIV(DIVINT) ; convert internal division to external
+1 NEW DIC,DA,DR,DIVAR,DIVXAR
+2 SET DIC=40.8
SET DA=DIVINT
SET DR=".01"
+3 DO GETS^DIQ(DIC,DA,DR,"E","DIVXAR")
+4 SET DIVEX=$GET(DIVXAR(40.8,DIVINT_",",.01,"E"))
+5 IF DIVEX=""!($LENGTH(DIVEX)<3)
SET DIVEX=$PIECE($$SITE^VASITE,"^",2)
+6 QUIT DIVEX
+7 ;
WEEKS(SDDT,WEEKS) ; Get ending dates for 52 weeks
+1 NEW TODAY,NEXTD,STARTD,NEXTW
KILL WEEKS
SET WEEKS=""
SET STARTD=""
+2 SET TODAY=$$DOW^XLFDT(SDDT)
IF TODAY="Sunday"
SET STARTD=SDDT
+3 IF TODAY'="Sunday"
FOR I=1:1:6
Begin DoDot:1
+4 SET NEXTD=$$FMADD^XLFDT(SDDT,I)
IF $$DOW^XLFDT(NEXTD)="Sunday"
SET STARTD=NEXTD
End DoDot:1
if $GET(STARTD)
QUIT
+5 FOR I=1:1:53
SET NEXTW=$PIECE($$FMADD^XLFDT(STARTD,I*7),".")
SET WEEKS(NEXTW)=NEXTW
+6 QUIT
+7 ;
GETDIV(CLINIC) ; Return CLINIC's division from file 40.8
+1 NEW DIC,DA,DR,CLINAR
+2 if '$GET(CLINIC)
QUIT ""
+3 SET DIQ(0)="I"
SET DIC=44
SET DA=CLINIC
SET DR="3.5"
+4 DO GETS^DIQ(DIC,+DA,DR,"I","CLINAR")
+5 SET SDIV=$GET(CLINAR(44,CLINIC_",",3.5,"I"))
+6 IF '(SDIV>0)
SET SDIV=$PIECE($$SITE^VASITE,"^",2)
+7 QUIT SDIV
+8 ;
AGGDT(SDBEGRNG,SDENDRNG,DTRANGE,SDNODE) ; Aggregate Facility, Divisions, Clinics, Providers by Date
+1 NEW SDFAC,SDIV,SDRPTYP,SDCL,SDPRV,SDDT,SDDTAG,SDENDATE,SDPRVND
+2 NEW TMPWK,TMPMON,TMPQRT,TMPYR,AGGDATA
+3 SET SDRPTYP=""
FOR
SET SDRPTYP=$ORDER(^XTMP(SDNODE,"Date",SDRPTYP))
if SDRPTYP=""
QUIT
Begin DoDot:1
+4 SET SDDT=0
FOR
SET SDDT=$ORDER(^XTMP(SDNODE,"Date",SDRPTYP,SDDT))
if 'SDDT
QUIT
Begin DoDot:2
+5 SET TMPMON=$EXTRACT(SDDT,1,5)_"00"
+6 IF '$GET(TMPYR)
SET TMPYR=$EXTRACT(SDDT,1,3)_"0000"
+7 SET TMPWK=$$GETWEEK(SDDT,.SDWEEKS)
+8 SET TMPQRT=$$GETQUART(SDDT)
+9 SET SDFAC=""
FOR
SET SDFAC=$ORDER(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC))
if SDFAC=""
QUIT
Begin DoDot:3
+10 SET SDIV=""
FOR
SET SDIV=$ORDER(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV))
if 'SDIV
QUIT
Begin DoDot:4
+11 ;Q:SDIV="APP"
+12 SET SDGRP=""
FOR
SET SDGRP=$ORDER(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP))
if SDGRP=""
QUIT
Begin DoDot:5
+13 if SDGRP="APP"
QUIT
if (SDGRP=0)
QUIT
+14 SET SDCL=""
FOR
SET SDCL=$ORDER(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL))
if SDCL=""
QUIT
Begin DoDot:6
+15 if SDCL="APP"
QUIT
DO SUP^SDCED2
+16 SET SDPRV=""
FOR
SET SDPRV=$ORDER(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL,SDPRV))
if SDPRV=""
QUIT
Begin DoDot:7
+17 if (SDPRV'["^")
QUIT
+18 ;
+19 ; Appointments
+20 DO APPT^SDCED2(SDNODE,SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL,SDPRV,DTRANGE,TMPMON,TMPQRT,TMPYR,.SDWEEKS)
+21 ;
+22 ; Get smallest encounter aggregation
+23 SET SDPRVND=$GET(^XTMP(SDNODE,"Date",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL,SDPRV))
+24 if SDPRVND=""
QUIT
+25 ;
+26 ; Add daily provider aggregation to Group
+27 DO AGGSET("^XTMP(SDNODE,""Date"",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP)","Date",SDPRVND)
+28 ;
+29 ; Add daily provider aggregation to appropriate Clinic
+30 DO AGGSET("^XTMP(SDNODE,""Date"",SDRPTYP,SDDT,SDFAC,SDIV,SDGRP,SDCL)","Date",SDPRVND)
+31 ;
+32 NEW DTNAM,TOT1,TOT2,TOT3,TOT4,SDGLROOT,SDGLFULL
+33 IF '($GET(SDBEGRNG)&$GET(SDENDRNG))
SET SDGLROOT="^XTMP(SDNODE,DTNAM,SDRPTYP,TMPDT,SDFAC"
Begin DoDot:8
+34 ; Aggregate Annual, Quarterly, Monthly, Weekly Group, Division, Clinic, Provider
+35 FOR DTNAM="Year","Month","Week","Quarter"
Begin DoDot:9
+36 FOR SDGLFULL=SDGLROOT_")",SDGLROOT_",SDIV)",SDGLROOT_",SDIV,SDGRP)",SDGLROOT_",SDIV,SDGRP,SDCL)",SDGLROOT_",SDIV,SDGRP,SDCL,SDPRV)"
Begin DoDot:10
+37 ; Don't add each group to facility and division totals - already done with group 0 (all)
+38 ;I SDGRP Q:(SDGLFULL[",SDIV)")!(SDGLFULL[",SDFAC)")
+39 IF SDGRP
if '(SDGLFULL["SDGRP")
QUIT
+40 DO AGGSET(SDGLFULL,DTNAM,SDPRVND)
End DoDot:10
End DoDot:9
End DoDot:8
+41 ;
+42 ; Resource Group Specific aggregations (Annual, Quarterly, Monthly, Weekly, Daily)
+43 SET SDGLROOT="^XTMP(SDNODE,""GROUP"",DTNAM,SDRPTYP,TMPDT"
Begin DoDot:8
+44 FOR DTNAM="Year","Quarter","Month","Week","Date"
Begin DoDot:9
+45 IF $GET(SDBEGRNG)&$GET(SDENDRNG)
if '(DTNAM="Date")
QUIT
+46 SET SDGLFULL=SDGLROOT_",SDFAC,SDGRP)"
DO AGGSET(SDGLFULL,DTNAM,SDPRVND)
+47 SET SDGLFULL=SDGLROOT_",SDFAC,SDGRP,""CLIN"",SDCL)"
DO AGGSET(SDGLFULL,DTNAM,SDPRVND)
End DoDot:9
End DoDot:8
+48 ;
+49 ; Provider Specific aggregations (Annual, Quarterly, Monthly, Weekly, Daily)
+50 SET SDGLROOT="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT"
+51 FOR DTNAM="Year","Quarter","Month","Week","Date"
Begin DoDot:8
+52 IF $GET(SDBEGRNG)&$GET(SDENDRNG)
if '(DTNAM="Date")
QUIT
+53 SET SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""FAC"",SDFAC,SDPRV)"
DO AGGSET(SDGLFULL,DTNAM,SDPRVND)
+54 SET SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""FAC"",SDFAC,""CLIN"",SDCL,""PROV"",SDPRV)"
DO AGGSET(SDGLFULL,DTNAM,SDPRVND)
+55 SET SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""DIV"",SDIV,SDPRV)"
DO AGGSET(SDGLFULL,DTNAM,SDPRVND)
+56 SET SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""DIV"",SDIV,""CLIN"",SDCL,SDPRV)"
DO AGGSET(SDGLFULL,DTNAM,SDPRVND)
+57 SET SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,""GRP"",SDGRP,SDPRV)"
DO AGGSET(SDGLFULL,DTNAM,SDPRVND)
+58 SET SDGLFULL="^XTMP(SDNODE,""PROVIDER"",DTNAM,SDRPTYP,TMPDT,"_SDIV_",""GRP"",SDGRP,SDPRV)"
DO AGGSET(SDGLFULL,DTNAM,SDPRVND)
+59 ;
+60 ; Don't add each group to facility and division totals - already done with group 0 (all)
+61 ; Add daily provider aggregation to division
+62 if ($GET(SDGRP)=0)
QUIT
+63 DO AGGSET("^XTMP(SDNODE,DTNAM,SDRPTYP,TMPDT,SDFAC,SDIV)",DTNAM,SDPRVND)
+64 ;
+65 ; Add daily provider aggregation to facility
+66 DO AGGSET("^XTMP(SDNODE,DTNAM,SDRPTYP,TMPDT,SDFAC)",DTNAM,SDPRVND)
End DoDot:8
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+67 QUIT
+68 ;
AGGSET(SDGLOB,DTNAM,PRVND) ; Perform generic aggregation of Pn values into SDGLOB
+1 ; Encounter data stored in @SDGLOB
+2 NEW I,TMPDT,TOT,AGGDATA
+3 SET TMPDT=$SELECT(DTNAM="Year":TMPYR,DTNAM="Quarter":TMPQRT,DTNAM="Month":TMPMON,DTNAM="Week":TMPWK,1:SDDT)
+4 SET TOT=$GET(@(SDGLOB))
+5 FOR I=1:1:$LENGTH(PRVND,"^")
SET $PIECE(AGGDATA,"^",I)=($PIECE(TOT,"^",I)+$PIECE(PRVND,"^",I))
+6 SET @(SDGLOB)=AGGDATA
+7 QUIT
+8 ;
GRP(LOC,GROUP) ; Get clinic groups
+1 ; Look in Clinic Group for now, until Medsphere code is available
+2 KILL GROUP
SET GROUP=""
+3 NEW LOCNUM,DIC,X,Y
SET DIC=44
SET DIC(0)="MZ"
SET X=LOC
DO ^DIC
if (Y<1)
QUIT
SET LOCNUM=+Y
+4 NEW CGRP
SET CGRP=0
FOR
SET CGRP=$ORDER(^PS(57.8,"AC",LOCNUM,CGRP))
if 'CGRP
QUIT
Begin DoDot:1
+5 SET GROUP(LOC,CGRP)=$PIECE($GET(^PS(57.8,+CGRP,0)),"^")
End DoDot:1
+6 QUIT
+7 ;
GETWEEK(SDDT,SDWEEKS) ; Return the week-ending date for date SDDT
+1 KILL TMPWK
+2 SET TMPWK=$GET(SDWEEKS($PIECE(SDDT,".")))
IF 'TMPWK
SET TMPWK=$PIECE($ORDER(SDWEEKS(SDDT)),".")
IF TMPWK["."
+3 SET TMPWK=$$FMADD^XLFDT(TMPWK,-1)
+4 QUIT TMPWK
+5 ;
GETQUART(SDDT) ; Return quarter
+1 KILL SDQUART
NEW MONTH,YEAR
+2 SET YEAR=$$FMTE^XLFDT($EXTRACT(SDDT,1,3)_"0000")
+3 SET MONTH=$EXTRACT(SDDT,4,5)
+4 SET SDQUART=$SELECT(MONTH<4:"Q1",MONTH<7:"Q2",MONTH<10:"Q3",MONTH<13:"Q4",1:"Q0")
+5 ;S SDQUART=SDQUART_"-"_YEAR
+6 SET SDQUART=YEAR_"-"_SDQUART
+7 QUIT SDQUART
+8 ;
SUPPLY(SDNODE,DTINC,SDRPTYP,SDDT,SDFAC,SDIV,SDCL,SUPPLY) ; Get Supply
+1 if 'SUPPLY
QUIT
+2 NEW SDDATE,SDGRP,TMPSUP,CLNAM
+3 DO SDGRP^SDECXUTL(+SDCL,.SDGRP)
+4 SET SDDATE=$SELECT($GET(DTRANGE):DTRANGE,1:SDDT)
+5 SET CLNAM=$SELECT($GET(SDCL):$PIECE($GET(^SC(+SDCL,0)),"^"),1:$PIECE(SDCL,"^"))
+6 ;
+7 SET TMPSUP=$GET(^XTMP(SDNODE,DTINC,SDRPTYP,$PIECE(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,"APP","SUP"))
+8 SET TMPSUP=TMPSUP+SUPPLY
+9 SET ^XTMP(SDNODE,DTINC,SDRPTYP,$PIECE(SDDATE,"."),SDFAC,SDIV,SDGRP,CLNAM_"^"_SDCL,"APP","SUP")=TMPSUP
+10 QUIT
