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

SDCED1.m

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