- 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 Jan 18, 2025@03:50:05 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