SDCED ;ALB/JCH - VSE GUI RESOURCE MANAGEMENT REPORT DATA COMPILER ;19 Oct 14 04:11PM
;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
;;
; Reference to NOTES^TIUSRVLV is supported by ICR #2812
; Reference to V PROVIDER file is supported by ICR #2316
Q
QUEUE ; Task to background
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
S ZTIO=""
;
I $$ISLOCKED() Q
;
S ZTRTN="EN^SDCED"
S ZTSAVE("SDECMAIL")=""
S ZTDTH=$$NOW^XLFDT
S ZTDESC="SD Resource Management Report Data Compiler"
D ^%ZTLOAD
Q
;
EN ; This utility will create a temporary storage global in ^XTMP("SDVSE") that contains
; data used by the VSE GUI Resource Management Reports.
;
N SDFAC,DATE,SDWEEKS,SDSTPAR,SDSTART,SDECTOT,OLOC,SDRPT,SDRPTAR,SDBEGRNG,SDENDRNG,DTRANGE,PROV
N SDSTRT,SDSTP,SDCMP,DAYS,STCNT,STGL
;
S STGL="^XTMP(""SDVSE"",""RPTSTATS"")" K @STGL
; If last process completed successfully, only check for data for the last 90 days
; from the last completed process.
S DAYS=$S($P($G(^XTMP("SDVSE",0)),U,5)'="":90,1:365)
S SDATE=$$NOW^XLFDT
S SDSTART=$$FMADD^XLFDT(SDATE,-DAYS),SDEND=$$NOW^XLFDT
S SDFAC=$P($$SITE^VASITE(),"^",2)
;
I '$$LOCK() D Q
.I '$G(ZTSK) W !!?5,"SD Resource Management Report Data compile cannot be started at this time.",!! D PAUSE
;
D BLDSTAT("")
D BLDSTAT("SDEC REPORT DATA option runtime statistics")
D BLDSTAT("------------------------------------------"),BLDSTAT("")
D BLDSTAT("Collecting data from "_$$FMTE^XLFDT(SDSTART)_" to "_$$FMTE^XLFDT(SDEND)),BLDSTAT("")
D GETCLNS^SDECSTP(.SDSTPAR)
; Get Clinic Appointment data
S SDSTRT=$$NOW^XLFDT D RPT^SDECRPT(DAYS,.SDSTPAR) S SDSTP=$$NOW^XLFDT,SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3) D
. D BLDSTAT("Collect Clinic Appointment Data:")
. D BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
. D BLDSTAT(" Total Run Time: "_$S(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
; Get Clinic Supply data
N SDSTRT,SDSTP,SDCMP S SDSTRT=$$NOW^XLFDT D SUPPLY S SDSTP=$$NOW^XLFDT,SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3) D
. D BLDSTAT("")
. D BLDSTAT("Collect Clinic Supply Data:")
. D BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
. D BLDSTAT(" Total Run Time: "_$S(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
; Get Provider Outpatient Appointment data
N SDSTRT,SDSTP,SDCMP S SDSTRT=$$NOW^XLFDT D PROVIDER S SDSTP=$$NOW^XLFDT,SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3) D
. D BLDSTAT("")
. D BLDSTAT("Collect Provider Data:")
. D BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
. D BLDSTAT(" Total Run Time: "_$S(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
; Merge all compiled data
D MERGE(SDATE)
F SDRPT="M","P","S" S SDRPTAR(SDRPT)=""
N SDSTRT,SDSTP,SDCMP S SDSTRT=$$NOW^XLFDT D EN^SDCED1(.SDRPTAR) S SDSTP=$$NOW^XLFDT,SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3) D
. D BLDSTAT("")
. D BLDSTAT("Cross Reference and Aggregate All Data:")
. D BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
. D BLDSTAT(" Total Run Time: "_$S(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
; Build the Report Filter data
N SDSTRT,SDSTP,SDCMP,XMLNODE
S SDSTRT=$$NOW^XLFDT,XMLNODE="FLTXML" D START^SDECXML("MPS","YQMWD",,,1,"","",XMLNODE) S SDSTP=$$NOW^XLFDT,SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3) D
. D BLDSTAT("")
. D BLDSTAT("Build Filter Data:")
. D BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
. D BLDSTAT(" Total Run Time: "_$S(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
; Build the Full Year Report data
N SDLAST,SDSTRT,SDBEGDT,SDSTP,SDCMP,XMLNODE
S SDSTRT=$$NOW^XLFDT,SDLAST=$O(^XTMP("SDVSE","DT",""),-1),SDBEGDT=$$FMADD^XLFDT(SDLAST,-365),XMLNODE="YRPTXML-S"
D START^SDECXML("S","D",SDBEGDT,SDSTRT,,"Year","",XMLNODE) S SDSTP=$$NOW^XLFDT,SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3) D
. D BLDSTAT("")
. D BLDSTAT("Build Specialty Care Year XML Report Data:")
. D BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
. D BLDSTAT(" Total Run Time: "_$S(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
N SDLAST,SDSTRT,SDBEGDT,SDSTP,SDCMP,XMLNODE
S SDSTRT=$$NOW^XLFDT,SDLAST=$O(^XTMP("SDVSE","DT",""),-1),SDBEGDT=$$FMADD^XLFDT(SDLAST,-365),XMLNODE="YRPTXML-P"
D START^SDECXML("P","D",SDBEGDT,SDSTRT,,"Year","",XMLNODE) S SDSTP=$$NOW^XLFDT,SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3) D
. D BLDSTAT("")
. D BLDSTAT("Build Primary Care Year XML Report Data:")
. D BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
. D BLDSTAT(" Total Run Time: "_$S(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
N SDLAST,SDSTRT,SDBEGDT,SDSTP,SDCMP,XMLNODE
S SDSTRT=$$NOW^XLFDT,SDLAST=$O(^XTMP("SDVSE","DT",""),-1),SDBEGDT=$$FMADD^XLFDT(SDLAST,-365),XMLNODE="YRPTXML-M"
D START^SDECXML("M","D",SDBEGDT,SDSTRT,,"Year","",XMLNODE) S SDSTP=$$NOW^XLFDT,SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3) D
. D BLDSTAT("")
. D BLDSTAT("Build Mental Health Year XML Report Data:")
. D BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
. D BLDSTAT(" Total Run Time: "_$S(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
D CLEAN,RPTSTAT
Q
;
PROVIDER ; Get encounters by provider
N ENCDCNT,SDDT,SDPR,SDCL,SDCEX,TMPDAY,NXTDAY,SVCAT,SDEC,SDIV
N CLSTOP,SDEST,DFN,ENC,BDATE,CDATE,LOC,CATEGORY,SDNEW,SDIV
D BLDPRDT("PR",$P(SDSTART,"."),.SDSTPAR,SDEND)
S SDIV="" F S SDIV=$O(^TMP("SDECX",$J,"CL",SDIV)) Q:'SDIV D
.S SDEC="" F S SDEC=$O(^TMP("SDECX",$J,"CL",SDIV,SDEC)) Q:SDEC="" D
..S SDCL=0 F S SDCL=$O(^TMP("SDECX",$J,"CL",SDIV,SDEC,SDCL)) Q:'SDCL D CNTPROV(SDIV,SDEC,SDCL)
Q
;
CNTPROV(SDIV,SDEC,SDCL) ; aggregate daily encounters by provider
N SDEST,SDNEW,TELCATD,DIVEX,CLINEX,PROVEX S SDEST=0,SDNEW=0
S SDPR=0 F S SDPR=$O(^TMP("SDECX",$J,"CL",SDIV,SDEC,SDCL,"PR",SDPR)) Q:'SDPR D
.S ENCDCNT=0,TELCATD=0
.S SDDT=0 F S SDDT=$O(^TMP("SDECX",$J,"CL",SDIV,SDEC,SDCL,"PR",SDPR,SDDT)) Q:'SDDT S TMPDAY=$P(SDDT,".") D
..N ENC,SDDFN
..S ENC=0 F S ENC=$O(^TMP("SDECX",$J,"CL",SDIV,SDEC,SDCL,"PR",SDPR,SDDT,ENC)) Q:'ENC D
...N SDENCND,SVCAT,SDSGNM,SDTMPND,AGGDATA
...S SDENCND=$G(^TMP("SDECX",$J,"CL",SDIV,SDEC,SDCL,"PR",SDPR,SDDT,ENC))
...S SDSGNM="" D GETSCAT(SDCL,.SDSGNM,.SDSTPAR) ; Get Stop Code Group Name
...Q:SDSGNM="UNKNOWN"
...S SVCAT=$P(SDENCND,"^"),TELCATD=$S(SVCAT="T":1,1:0)
...S SDEST=+$P(SDENCND,"^",2),SDNEW=$S($G(SDEST):0,1:1)
...S SDTMPND=$G(^TMP("SDCEX",$J,$E(SDSGNM),+SDCL,SDDT,+SDPR,"ENC"))
...S AGGDATA=($P(SDTMPND,"^")+1)_"^"_(SDNEW+$P(SDTMPND,"^",2))_"^"_(SDEST+$P(SDTMPND,"^",3))_"^"_(TELCATD+$P(SDTMPND,"^",4))
...S ^TMP("SDCEX",$J,$E(SDSGNM),+SDCL,SDDT,+SDPR,"ENC")=AGGDATA
Q
;
CLEAN ; Clean up
K ^TMP("SDECX",$J),^TMP("SDCEX",$J)
S $P(^XTMP("SDVSE",0),U,5)=$$NOW^XLFDT()
N SDSTRT,SDSTP,SDCMP
S SDSTRT=$P(^XTMP("SDVSE",0),U,2),SDSTP=$P(^XTMP("SDVSE",0),U,5)
S SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
D BLDSTAT("")
D BLDSTAT("SDEC REPORT DATA Option:")
D BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
D BLDSTAT(" Total Run Time: "_SDCMP_" (DD HH:MM:SS)")
D BLDSTAT(""),BLDSTAT("")
D BLDSTAT("*****************************************************************")
D BLDSTAT("This message can be disabled by setting the SDECMAIL value in the")
D BLDSTAT("Entry Action field of the SDEC REPORT DATA Option to zero.")
D BLDSTAT("ENTRY ACTION: S SDECMAIL=0"),BLDSTAT("")
D BLDSTAT("To re-enable the statistics, set the value back to one.")
D BLDSTAT("ENTRY ACTION: S SDECMAIL=1")
D BLDSTAT("*****************************************************************")
Q
;
BLDPRDT(ENCTYP,SDSTARTD,SDSTPAR,SDEND) ; Collect Provider Encounter data from ENCOUNTER (#409.68) file "D" xref
N II,IC,SDENC,SDENCDT,SDENCPR,SDENCL,DGENDTST,SDDIVI,SDDIVIE,SDGRPA,SDEST,SDNEW,SDENCND,VISIT,SDCHILD,SDCKODT
S DGENDTST=$$FMADD^XLFDT(SDSTARTD,,,-1)
S SDEND=$P(SDEND,".")_".24"
F S DGENDTST=$O(^SCE("D",DGENDTST)) Q:'DGENDTST!(DGENDTST>SDEND) D
.S SDCKODT=0 F II=1:1 S SDCKODT=$O(^SCE("D",DGENDTST,SDCKODT)) Q:'SDCKODT D
..S SDENC=0 F IC=1:1 S SDENC=$O(^SCE("D",DGENDTST,SDCKODT,SDENC)) Q:'SDENC D
...N SDDFN,CDATE,SDEST,SDNEW,SDAPDATA,ENCARAY,SDENC0,SDVISIT
...N SDVPRV,SDENCAR,SDVAR
...; Delete invalid cross references
...I '$D(^SCE(SDENC,0)) K ^SCE("D",DGENDTST,SDCKODT,SDENC) Q
...S SDENC0=^SCE(SDENC,0)
...S SDVISIT=$P(SDENC0,U,5) Q:$G(SDVISIT)=""
...S SDENCPR=$$VPRV(SDVISIT) Q:$G(SDENCPR)=""
...S SDENCL=$P(SDENC0,U,4) Q:'$G(SDENCL)
...S SDENCDT=$P(SDENC0,U) Q:'$G(SDENCDT)
...S SDDIVI=$P(SDENC0,U,11) Q:$G(SDDIVI)=""
...S SDDFN=$P($G(^SCE(+SDENC,0)),"^",2) Q:'$G(SDDFN)
...S CDATE=DGENDTST
...N SDTMPLOC,SDTMPSTP S SDTMPSTP=$P($G(^SCE(+SDENC,0)),"^",3) Q:'SDTMPSTP
...S SDTMPLOC=$$CHKEST(SDDFN,CDATE,SDENC,.SDTMPSTP) S SDEST=$S(+$G(SDTMPLOC):1,1:""),SDNEW=$S($G(SDEST):0,1:1)
...S SVCAT="" S SVCAT=$S($$TELE(SDVISIT):"T",1:$P($G(^AUPNVSIT(+SDVISIT,0)),"^",7))
...N SDSGNM S SDSGNM="" D GETSCAT(SDENCL,.SDSGNM,.SDSTPAR) ; Get Stop Code Group Name
...S ^TMP("SDECX",$J,"CL",+$G(SDDIVI),SDSGNM,SDENCL,"PR",SDENCPR,SDENCDT,SDENC)=SVCAT_"^"_$G(SDEST)
Q
;
MERGE(SDATE) ; copy data to ^TMP
M ^XTMP("SDVSE","DT",$P(SDATE,"."))=^TMP("SDCEX",$J)
K ^TMP("SDCEX",$J)
Q
;
GETSCAT(SDLOC,SDSGNM,SDSTPAR) ; Get Stop Code Group Name
N CSTOP S CSTOP="",SDSGNM="UNKNOWN"
D CLSTOP(SDLOC,.CSTOP)
I $G(CSTOP) D STOPCAT(CSTOP,.SDSGNM,.SDSTPAR)
Q
;
STOPCAT(CLSTOP,CAT,SDSTPAR) ; 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(SDSTPAR(STPCNT)) Q:(STPCNT="")!$G(FOUND) D
.S CLINEX="" F S CLINEX=$O(SDSTPAR(STPCNT,CLINEX)) Q:CLINEX=""!$G(FOUND) D
..I +$P($G(SDSTPAR(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
;
CLSTOP(SDLOC,CSTOP) ; Get Clinic Stop
N X,Y,DIQ,DIC,DA,DR,SDCS K CSTOP S CSTOP=""
S DIC="44",DA=SDLOC,DR="8"
D GETS^DIQ(DIC,DA,DR,"I","SDCS")
S CSTOP=$G(SDCS(DIC,DA_",",8,"I"))
Q:'CSTOP K SDCS
N X,Y,DIQ,DIC,DA,DR
S DIC=40.7,DA=CSTOP,DR="1"
D GETS^DIQ(DIC,DA,DR,"I","SDCS")
S CSTOP=$G(SDCS(DIC,DA_",",1,"I"))
Q
;
CHKEST(DFN,BDATE,ENC,CLSTOP) ; Was Patient DFN's encounter on date DATE considered Established or New?
N 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)
;
TELE(VISIT) ; If the Visit has at least one telephone note, return true
N TMPNM,SDPHN,GLB S TMPNM=""
D NOTES^TIUSRVLV(.TMPNM,VISIT)
Q:TMPNM="" "" S SDPHN=0
S GLB=TMPNM F Q:$G(SDPHN) S GLB=$Q(@GLB) Q:GLB'["TIU"!(GLB'[$J) I @GLB["TELEPHON" S SDPHN=1
Q $S($G(SDPHN):1,1:0)
;
VPRV(VISIT) ; Find encounter provider
Q:'$G(VISIT)
N VPRV,ENCARAY,VARAY,DIC,DA,DR,DIQ
S VPRV=$O(^AUPNVPRV("AD",+VISIT,0))
Q:'VPRV ""
Q +$P(^AUPNVPRV(VPRV,0),U)
;
SUPPLY ; Supply by clinic
N RDT S RDT=DT
D SUPPLY^SDECXUTL(.SDSTPAR)
Q
;
NONCNT(SDCL) ; Non-Count Clinic?
Q $S($P($G(^SC(+SDCL,0)),"^",17)="Y":1,1:0)
;
ISLOCKED() ; -- Returns 1 if the locked, otherwise 0 if unlocked
; Format of zero node:
; ^XTMP("SDVSE",0)="Save Through Date/Time^Last Start Date/Time^Description^Task #^Complete Date/Time
; Check if top level node does not exist then let it run
I '$D(^XTMP("SDVSE",0)) Q 0
; Check the task status. If task defined and is still running then it's locked
I +$P($G(^XTMP("SDVSE",0)),U,4),$$TSKSTAT($P(^XTMP("SDVSE",0),U,4)) Q "1^Resource Management Report data is compiling. Please try again later."
; Not Locked
Q 0
;
LOCK() ; -- lock "SDCEX,0" node
I +$$ISLOCKED() Q 0
S ^XTMP("SDVSE",0)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,)_U_$$NOW^XLFDT_U_"SD Resource Management Report Data compile started by "_$P(^VA(200,DUZ,0),U)_U_$G(ZTSK)_U_""
Q 1
;
TSKSTAT(ZTSK) ; Check the status of a task
; Returns 0 if task is undefined or 1 if task is still running
D STAT^%ZTLOAD
I 'ZTSK(0) Q 0
; Task status is still Active if ZTSK(1)=1 or 2
I ZTSK(1)=1!(ZTSK(1)=2) Q 1
; Any other task status means the task is inactive
Q 0
;
BLDSTAT(TEXT) ; Build the report data collection stats email text
I $G(STCNT)="" S STCNT=0
I $G(STGL)="" S STGL="^XTMP(""SDVSE"",""RPTSTATS"")"
S STCNT=STCNT+1
S @STGL@(0)="",@STGL@(STCNT)=TEXT
Q
;
RPTSTAT ; Report the status of the job
N XMSUB,XMTEXT,XMDUZ,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,TMPDUZ
S $P(^XTMP("SDECMAIL",0),U)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,)
Q:$G(SDECMAIL)'=1
S TMPDUZ=$P($G(^XTMP("SDECMAIL",0)),U,2)
Q:'TMPDUZ
S XMY(TMPDUZ)="",XMSUB="SDEC REPORT DATA Stats for "_$$FMTE^XLFDT($$NOW^XLFDT)
S XMTEXT=$P(STGL,")")_","
D ^XMD
; Reset Purge date for MailMan Status Report user id.
S $P(^XTMP("SDECMAIL",0),U)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,)
Q
;
EXITOPT ; SD VSE REPORT DATA option exit action
I '$D(IO("Q")) D Q
.I '$G(ZTSK),+$P($G(^XTMP("SDVSE",0)),U,4),$$TSKSTAT($P(^XTMP("SDVSE",0),U,4)) W !!?5,"SD Resource Management Report Data compile has been queued.",!! D PAUSE Q
.I '$G(ZTSK),+$P($G(^XTMP("SDVSE",0)),U,2),$P($G(^XTMP("SDVSE",0)),U,5)="" W !!?5,"SD Resource Management Report Data compile is running",!! D PAUSE
.I '$G(ZTSK),+$P($G(^XTMP("SDVSE",0)),U,2),+$P($G(^XTMP("SDVSE",0)),U,5) W !!?5,"SD Resource Management Report has completed",!! D PAUSE
Q
;
SETDXREF(DA) ; This function is the set condition for the "D" index on the Outpatient Encounter file #409.68
; This cross reference is only used by the VistA Scheduling GUI Resource Management Reports.
; The cross reference is used to collect the total Outpatient Encounters for a Provider over a year time period.
; Verify that all required fields exist before setting cross reference
; Input: DA = IEN of file 409.68
N SDOK,SDEDT,SDLOC,SDVST S SDOK=0
; Don't set index if Date of encounter greater than one year and a day in the past.
S SDEDT=$P(^SCE(DA,0),U) I $$FMDIFF^XLFDT(DT,SDEDT,1)>366 Q SDOK
; Don't set index if this is a Child Encounter
Q:+$P(^SCE(DA,0),U,6) SDOK
; Don't set if Visit is not defined
S SDVST=$P(^SCE(DA,0),U,5) Q:SDVST="" SDOK
; Don't set index if Encounter Provider is not defined in the V PROVIDER file
Q:'$O(^AUPNVPRV("AD",+SDVST,0)) SDOK
; Don't set index if Location not defined
S SDLOC=$P(^SCE(DA,0),U,4) Q:'$D(^SC(+SDLOC)) SDOK
; Don't set index if Location is a non-count clinic
Q:$P($G(^SC(+SDLOC,0)),"^",17)="Y" SDOK
Q 1
;
KILDXREF(DA) ; This function is the kill condition for the "D" index ont he Outpatient Encounter file #409.68
N SDOK,SDEDT,SDVST S SDOK=1
; Kill index if date of encounter is greater than one year and a day in the past
S SDEDT=$P(^SCE(DA,0),U) I $$FMDIFF^XLFDT(DT,SDEDT,1)>366 Q SDOK
; Kill index if this is a Child Encounter
Q:+$P(^SCE(DA,0),U,6) SDOK
; Kill index if Visit is not defined
S SDVST=$P(^SCE(DA,0),U,5) Q:SDVST="" SDOK
; Kill index if Encounter Provider is not defined
Q:'$O(^AUPNVPRV("AD",+SDVST,0)) SDOK
; Kill index if Location not defined
S SDLOC=$P(^SCE(DA,0),U,4) Q:'$D(^SC(+SDLOC)) SDOK
; Kill index if Location is a non-count clinic
Q:$P($G(^SC(+SDLOC,0)),"^",17)="Y" SDOK
Q 0
;
PAUSE ;
Q:$E(IOST)'="C"!(IO'=IO(0))
N DIRUT,DUOUT
S DIR(0)="EO",DIR("A")="Press return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCED 16166 printed Apr 09, 2024@21:46:48 Page 2
SDCED ;ALB/JCH - VSE GUI RESOURCE MANAGEMENT REPORT DATA COMPILER ;19 Oct 14 04:11PM
+1 ;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
+2 ;;
+3 ; Reference to NOTES^TIUSRVLV is supported by ICR #2812
+4 ; Reference to V PROVIDER file is supported by ICR #2316
+5 QUIT
QUEUE ; Task to background
+1 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
+2 SET ZTIO=""
+3 ;
+4 IF $$ISLOCKED()
QUIT
+5 ;
+6 SET ZTRTN="EN^SDCED"
+7 SET ZTSAVE("SDECMAIL")=""
+8 SET ZTDTH=$$NOW^XLFDT
+9 SET ZTDESC="SD Resource Management Report Data Compiler"
+10 DO ^%ZTLOAD
+11 QUIT
+12 ;
EN ; This utility will create a temporary storage global in ^XTMP("SDVSE") that contains
+1 ; data used by the VSE GUI Resource Management Reports.
+2 ;
+3 NEW SDFAC,DATE,SDWEEKS,SDSTPAR,SDSTART,SDECTOT,OLOC,SDRPT,SDRPTAR,SDBEGRNG,SDENDRNG,DTRANGE,PROV
+4 NEW SDSTRT,SDSTP,SDCMP,DAYS,STCNT,STGL
+5 ;
+6 SET STGL="^XTMP(""SDVSE"",""RPTSTATS"")"
KILL @STGL
+7 ; If last process completed successfully, only check for data for the last 90 days
+8 ; from the last completed process.
+9 SET DAYS=$SELECT($PIECE($GET(^XTMP("SDVSE",0)),U,5)'="":90,1:365)
+10 SET SDATE=$$NOW^XLFDT
+11 SET SDSTART=$$FMADD^XLFDT(SDATE,-DAYS)
SET SDEND=$$NOW^XLFDT
+12 SET SDFAC=$PIECE($$SITE^VASITE(),"^",2)
+13 ;
+14 IF '$$LOCK()
Begin DoDot:1
+15 IF '$GET(ZTSK)
WRITE !!?5,"SD Resource Management Report Data compile cannot be started at this time.",!!
DO PAUSE
End DoDot:1
QUIT
+16 ;
+17 DO BLDSTAT("")
+18 DO BLDSTAT("SDEC REPORT DATA option runtime statistics")
+19 DO BLDSTAT("------------------------------------------")
DO BLDSTAT("")
+20 DO BLDSTAT("Collecting data from "_$$FMTE^XLFDT(SDSTART)_" to "_$$FMTE^XLFDT(SDEND))
DO BLDSTAT("")
+21 DO GETCLNS^SDECSTP(.SDSTPAR)
+22 ; Get Clinic Appointment data
+23 SET SDSTRT=$$NOW^XLFDT
DO RPT^SDECRPT(DAYS,.SDSTPAR)
SET SDSTP=$$NOW^XLFDT
SET SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
Begin DoDot:1
+24 DO BLDSTAT("Collect Clinic Appointment Data:")
+25 DO BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
+26 DO BLDSTAT(" Total Run Time: "_$SELECT(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
End DoDot:1
+27 ; Get Clinic Supply data
+28 NEW SDSTRT,SDSTP,SDCMP
SET SDSTRT=$$NOW^XLFDT
DO SUPPLY
SET SDSTP=$$NOW^XLFDT
SET SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
Begin DoDot:1
+29 DO BLDSTAT("")
+30 DO BLDSTAT("Collect Clinic Supply Data:")
+31 DO BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
+32 DO BLDSTAT(" Total Run Time: "_$SELECT(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
End DoDot:1
+33 ; Get Provider Outpatient Appointment data
+34 NEW SDSTRT,SDSTP,SDCMP
SET SDSTRT=$$NOW^XLFDT
DO PROVIDER
SET SDSTP=$$NOW^XLFDT
SET SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
Begin DoDot:1
+35 DO BLDSTAT("")
+36 DO BLDSTAT("Collect Provider Data:")
+37 DO BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
+38 DO BLDSTAT(" Total Run Time: "_$SELECT(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
End DoDot:1
+39 ; Merge all compiled data
+40 DO MERGE(SDATE)
+41 FOR SDRPT="M","P","S"
SET SDRPTAR(SDRPT)=""
+42 NEW SDSTRT,SDSTP,SDCMP
SET SDSTRT=$$NOW^XLFDT
DO EN^SDCED1(.SDRPTAR)
SET SDSTP=$$NOW^XLFDT
SET SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
Begin DoDot:1
+43 DO BLDSTAT("")
+44 DO BLDSTAT("Cross Reference and Aggregate All Data:")
+45 DO BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
+46 DO BLDSTAT(" Total Run Time: "_$SELECT(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
End DoDot:1
+47 ; Build the Report Filter data
+48 NEW SDSTRT,SDSTP,SDCMP,XMLNODE
+49 SET SDSTRT=$$NOW^XLFDT
SET XMLNODE="FLTXML"
DO START^SDECXML("MPS","YQMWD",,,1,"","",XMLNODE)
SET SDSTP=$$NOW^XLFDT
SET SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
Begin DoDot:1
+50 DO BLDSTAT("")
+51 DO BLDSTAT("Build Filter Data:")
+52 DO BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
+53 DO BLDSTAT(" Total Run Time: "_$SELECT(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
End DoDot:1
+54 ; Build the Full Year Report data
+55 NEW SDLAST,SDSTRT,SDBEGDT,SDSTP,SDCMP,XMLNODE
+56 SET SDSTRT=$$NOW^XLFDT
SET SDLAST=$ORDER(^XTMP("SDVSE","DT",""),-1)
SET SDBEGDT=$$FMADD^XLFDT(SDLAST,-365)
SET XMLNODE="YRPTXML-S"
+57 DO START^SDECXML("S","D",SDBEGDT,SDSTRT,,"Year","",XMLNODE)
SET SDSTP=$$NOW^XLFDT
SET SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
Begin DoDot:1
+58 DO BLDSTAT("")
+59 DO BLDSTAT("Build Specialty Care Year XML Report Data:")
+60 DO BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
+61 DO BLDSTAT(" Total Run Time: "_$SELECT(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
End DoDot:1
+62 NEW SDLAST,SDSTRT,SDBEGDT,SDSTP,SDCMP,XMLNODE
+63 SET SDSTRT=$$NOW^XLFDT
SET SDLAST=$ORDER(^XTMP("SDVSE","DT",""),-1)
SET SDBEGDT=$$FMADD^XLFDT(SDLAST,-365)
SET XMLNODE="YRPTXML-P"
+64 DO START^SDECXML("P","D",SDBEGDT,SDSTRT,,"Year","",XMLNODE)
SET SDSTP=$$NOW^XLFDT
SET SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
Begin DoDot:1
+65 DO BLDSTAT("")
+66 DO BLDSTAT("Build Primary Care Year XML Report Data:")
+67 DO BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
+68 DO BLDSTAT(" Total Run Time: "_$SELECT(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
End DoDot:1
+69 NEW SDLAST,SDSTRT,SDBEGDT,SDSTP,SDCMP,XMLNODE
+70 SET SDSTRT=$$NOW^XLFDT
SET SDLAST=$ORDER(^XTMP("SDVSE","DT",""),-1)
SET SDBEGDT=$$FMADD^XLFDT(SDLAST,-365)
SET XMLNODE="YRPTXML-M"
+71 DO START^SDECXML("M","D",SDBEGDT,SDSTRT,,"Year","",XMLNODE)
SET SDSTP=$$NOW^XLFDT
SET SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
Begin DoDot:1
+72 DO BLDSTAT("")
+73 DO BLDSTAT("Build Mental Health Year XML Report Data:")
+74 DO BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
+75 DO BLDSTAT(" Total Run Time: "_$SELECT(SDCMP]"":SDCMP,1:"0:00:01")_" (DD HH:MM:SS)")
End DoDot:1
+76 DO CLEAN
DO RPTSTAT
+77 QUIT
+78 ;
PROVIDER ; Get encounters by provider
+1 NEW ENCDCNT,SDDT,SDPR,SDCL,SDCEX,TMPDAY,NXTDAY,SVCAT,SDEC,SDIV
+2 NEW CLSTOP,SDEST,DFN,ENC,BDATE,CDATE,LOC,CATEGORY,SDNEW,SDIV
+3 DO BLDPRDT("PR",$PIECE(SDSTART,"."),.SDSTPAR,SDEND)
+4 SET SDIV=""
FOR
SET SDIV=$ORDER(^TMP("SDECX",$JOB,"CL",SDIV))
if 'SDIV
QUIT
Begin DoDot:1
+5 SET SDEC=""
FOR
SET SDEC=$ORDER(^TMP("SDECX",$JOB,"CL",SDIV,SDEC))
if SDEC=""
QUIT
Begin DoDot:2
+6 SET SDCL=0
FOR
SET SDCL=$ORDER(^TMP("SDECX",$JOB,"CL",SDIV,SDEC,SDCL))
if 'SDCL
QUIT
DO CNTPROV(SDIV,SDEC,SDCL)
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
CNTPROV(SDIV,SDEC,SDCL) ; aggregate daily encounters by provider
+1 NEW SDEST,SDNEW,TELCATD,DIVEX,CLINEX,PROVEX
SET SDEST=0
SET SDNEW=0
+2 SET SDPR=0
FOR
SET SDPR=$ORDER(^TMP("SDECX",$JOB,"CL",SDIV,SDEC,SDCL,"PR",SDPR))
if 'SDPR
QUIT
Begin DoDot:1
+3 SET ENCDCNT=0
SET TELCATD=0
+4 SET SDDT=0
FOR
SET SDDT=$ORDER(^TMP("SDECX",$JOB,"CL",SDIV,SDEC,SDCL,"PR",SDPR,SDDT))
if 'SDDT
QUIT
SET TMPDAY=$PIECE(SDDT,".")
Begin DoDot:2
+5 NEW ENC,SDDFN
+6 SET ENC=0
FOR
SET ENC=$ORDER(^TMP("SDECX",$JOB,"CL",SDIV,SDEC,SDCL,"PR",SDPR,SDDT,ENC))
if 'ENC
QUIT
Begin DoDot:3
+7 NEW SDENCND,SVCAT,SDSGNM,SDTMPND,AGGDATA
+8 SET SDENCND=$GET(^TMP("SDECX",$JOB,"CL",SDIV,SDEC,SDCL,"PR",SDPR,SDDT,ENC))
+9 ; Get Stop Code Group Name
SET SDSGNM=""
DO GETSCAT(SDCL,.SDSGNM,.SDSTPAR)
+10 if SDSGNM="UNKNOWN"
QUIT
+11 SET SVCAT=$PIECE(SDENCND,"^")
SET TELCATD=$SELECT(SVCAT="T":1,1:0)
+12 SET SDEST=+$PIECE(SDENCND,"^",2)
SET SDNEW=$SELECT($GET(SDEST):0,1:1)
+13 SET SDTMPND=$GET(^TMP("SDCEX",$JOB,$EXTRACT(SDSGNM),+SDCL,SDDT,+SDPR,"ENC"))
+14 SET AGGDATA=($PIECE(SDTMPND,"^")+1)_"^"_(SDNEW+$PIECE(SDTMPND,"^",2))_"^"_(SDEST+$PIECE(SDTMPND,"^",3))_"^"_(TELCATD+$PIECE(SDTMPND,"^",4))
+15 SET ^TMP("SDCEX",$JOB,$EXTRACT(SDSGNM),+SDCL,SDDT,+SDPR,"ENC")=AGGDATA
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
CLEAN ; Clean up
+1 KILL ^TMP("SDECX",$JOB),^TMP("SDCEX",$JOB)
+2 SET $PIECE(^XTMP("SDVSE",0),U,5)=$$NOW^XLFDT()
+3 NEW SDSTRT,SDSTP,SDCMP
+4 SET SDSTRT=$PIECE(^XTMP("SDVSE",0),U,2)
SET SDSTP=$PIECE(^XTMP("SDVSE",0),U,5)
+5 SET SDCMP=$$FMDIFF^XLFDT(SDSTP,SDSTRT,3)
+6 DO BLDSTAT("")
+7 DO BLDSTAT("SDEC REPORT DATA Option:")
+8 DO BLDSTAT(" Started at "_$$FMTE^XLFDT(SDSTRT)_" Finished at "_$$FMTE^XLFDT(SDSTP))
+9 DO BLDSTAT(" Total Run Time: "_SDCMP_" (DD HH:MM:SS)")
+10 DO BLDSTAT("")
DO BLDSTAT("")
+11 DO BLDSTAT("*****************************************************************")
+12 DO BLDSTAT("This message can be disabled by setting the SDECMAIL value in the")
+13 DO BLDSTAT("Entry Action field of the SDEC REPORT DATA Option to zero.")
+14 DO BLDSTAT("ENTRY ACTION: S SDECMAIL=0")
DO BLDSTAT("")
+15 DO BLDSTAT("To re-enable the statistics, set the value back to one.")
+16 DO BLDSTAT("ENTRY ACTION: S SDECMAIL=1")
+17 DO BLDSTAT("*****************************************************************")
+18 QUIT
+19 ;
BLDPRDT(ENCTYP,SDSTARTD,SDSTPAR,SDEND) ; Collect Provider Encounter data from ENCOUNTER (#409.68) file "D" xref
+1 NEW II,IC,SDENC,SDENCDT,SDENCPR,SDENCL,DGENDTST,SDDIVI,SDDIVIE,SDGRPA,SDEST,SDNEW,SDENCND,VISIT,SDCHILD,SDCKODT
+2 SET DGENDTST=$$FMADD^XLFDT(SDSTARTD,,,-1)
+3 SET SDEND=$PIECE(SDEND,".")_".24"
+4 FOR
SET DGENDTST=$ORDER(^SCE("D",DGENDTST))
if 'DGENDTST!(DGENDTST>SDEND)
QUIT
Begin DoDot:1
+5 SET SDCKODT=0
FOR II=1:1
SET SDCKODT=$ORDER(^SCE("D",DGENDTST,SDCKODT))
if 'SDCKODT
QUIT
Begin DoDot:2
+6 SET SDENC=0
FOR IC=1:1
SET SDENC=$ORDER(^SCE("D",DGENDTST,SDCKODT,SDENC))
if 'SDENC
QUIT
Begin DoDot:3
+7 NEW SDDFN,CDATE,SDEST,SDNEW,SDAPDATA,ENCARAY,SDENC0,SDVISIT
+8 NEW SDVPRV,SDENCAR,SDVAR
+9 ; Delete invalid cross references
+10 IF '$DATA(^SCE(SDENC,0))
KILL ^SCE("D",DGENDTST,SDCKODT,SDENC)
QUIT
+11 SET SDENC0=^SCE(SDENC,0)
+12 SET SDVISIT=$PIECE(SDENC0,U,5)
if $GET(SDVISIT)=""
QUIT
+13 SET SDENCPR=$$VPRV(SDVISIT)
if $GET(SDENCPR)=""
QUIT
+14 SET SDENCL=$PIECE(SDENC0,U,4)
if '$GET(SDENCL)
QUIT
+15 SET SDENCDT=$PIECE(SDENC0,U)
if '$GET(SDENCDT)
QUIT
+16 SET SDDIVI=$PIECE(SDENC0,U,11)
if $GET(SDDIVI)=""
QUIT
+17 SET SDDFN=$PIECE($GET(^SCE(+SDENC,0)),"^",2)
if '$GET(SDDFN)
QUIT
+18 SET CDATE=DGENDTST
+19 NEW SDTMPLOC,SDTMPSTP
SET SDTMPSTP=$PIECE($GET(^SCE(+SDENC,0)),"^",3)
if 'SDTMPSTP
QUIT
+20 SET SDTMPLOC=$$CHKEST(SDDFN,CDATE,SDENC,.SDTMPSTP)
SET SDEST=$SELECT(+$GET(SDTMPLOC):1,1:"")
SET SDNEW=$SELECT($GET(SDEST):0,1:1)
+21 SET SVCAT=""
SET SVCAT=$SELECT($$TELE(SDVISIT):"T",1:$PIECE($GET(^AUPNVSIT(+SDVISIT,0)),"^",7))
+22 ; Get Stop Code Group Name
NEW SDSGNM
SET SDSGNM=""
DO GETSCAT(SDENCL,.SDSGNM,.SDSTPAR)
+23 SET ^TMP("SDECX",$JOB,"CL",+$GET(SDDIVI),SDSGNM,SDENCL,"PR",SDENCPR,SDENCDT,SDENC)=SVCAT_"^"_$GET(SDEST)
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
MERGE(SDATE) ; copy data to ^TMP
+1 MERGE ^XTMP("SDVSE","DT",$PIECE(SDATE,"."))=^TMP("SDCEX",$JOB)
+2 KILL ^TMP("SDCEX",$JOB)
+3 QUIT
+4 ;
GETSCAT(SDLOC,SDSGNM,SDSTPAR) ; 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,.SDSTPAR)
+4 QUIT
+5 ;
STOPCAT(CLSTOP,CAT,SDSTPAR) ; 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(SDSTPAR(STPCNT))
if (STPCNT="")!$GET(FOUND)
QUIT
Begin DoDot:1
+4 SET CLINEX=""
FOR
SET CLINEX=$ORDER(SDSTPAR(STPCNT,CLINEX))
if CLINEX=""!$GET(FOUND)
QUIT
Begin DoDot:2
+5 IF +$PIECE($GET(SDSTPAR(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 ;
CLSTOP(SDLOC,CSTOP) ; Get Clinic Stop
+1 NEW X,Y,DIQ,DIC,DA,DR,SDCS
KILL CSTOP
SET CSTOP=""
+2 SET DIC="44"
SET DA=SDLOC
SET DR="8"
+3 DO GETS^DIQ(DIC,DA,DR,"I","SDCS")
+4 SET CSTOP=$GET(SDCS(DIC,DA_",",8,"I"))
+5 if 'CSTOP
QUIT
KILL SDCS
+6 NEW X,Y,DIQ,DIC,DA,DR
+7 SET DIC=40.7
SET DA=CSTOP
SET DR="1"
+8 DO GETS^DIQ(DIC,DA,DR,"I","SDCS")
+9 SET CSTOP=$GET(SDCS(DIC,DA_",",1,"I"))
+10 QUIT
+11 ;
CHKEST(DFN,BDATE,ENC,CLSTOP) ; Was Patient DFN's encounter on date DATE considered Established or New?
+1 NEW 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 ;
TELE(VISIT) ; If the Visit has at least one telephone note, return true
+1 NEW TMPNM,SDPHN,GLB
SET TMPNM=""
+2 DO NOTES^TIUSRVLV(.TMPNM,VISIT)
+3 if TMPNM=""
QUIT ""
SET SDPHN=0
+4 SET GLB=TMPNM
FOR
if $GET(SDPHN)
QUIT
SET GLB=$QUERY(@GLB)
if GLB'["TIU"!(GLB'[$JOB)
QUIT
IF @GLB["TELEPHON"
SET SDPHN=1
+5 QUIT $SELECT($GET(SDPHN):1,1:0)
+6 ;
VPRV(VISIT) ; Find encounter provider
+1 if '$GET(VISIT)
QUIT
+2 NEW VPRV,ENCARAY,VARAY,DIC,DA,DR,DIQ
+3 SET VPRV=$ORDER(^AUPNVPRV("AD",+VISIT,0))
+4 if 'VPRV
QUIT ""
+5 QUIT +$PIECE(^AUPNVPRV(VPRV,0),U)
+6 ;
SUPPLY ; Supply by clinic
+1 NEW RDT
SET RDT=DT
+2 DO SUPPLY^SDECXUTL(.SDSTPAR)
+3 QUIT
+4 ;
NONCNT(SDCL) ; Non-Count Clinic?
+1 QUIT $SELECT($PIECE($GET(^SC(+SDCL,0)),"^",17)="Y":1,1:0)
+2 ;
ISLOCKED() ; -- Returns 1 if the locked, otherwise 0 if unlocked
+1 ; Format of zero node:
+2 ; ^XTMP("SDVSE",0)="Save Through Date/Time^Last Start Date/Time^Description^Task #^Complete Date/Time
+3 ; Check if top level node does not exist then let it run
+4 IF '$DATA(^XTMP("SDVSE",0))
QUIT 0
+5 ; Check the task status. If task defined and is still running then it's locked
+6 IF +$PIECE($GET(^XTMP("SDVSE",0)),U,4)
IF $$TSKSTAT($PIECE(^XTMP("SDVSE",0),U,4))
QUIT "1^Resource Management Report data is compiling. Please try again later."
+7 ; Not Locked
+8 QUIT 0
+9 ;
LOCK() ; -- lock "SDCEX,0" node
+1 IF +$$ISLOCKED()
QUIT 0
+2 SET ^XTMP("SDVSE",0)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,)_U_$$NOW^XLFDT_U_"SD Resource Management Report Data compile started by "_$P(^VA(200,DUZ,0),U)_U_$GET(ZTSK)_U_""
+3 QUIT 1
+4 ;
TSKSTAT(ZTSK) ; Check the status of a task
+1 ; Returns 0 if task is undefined or 1 if task is still running
+2 DO STAT^%ZTLOAD
+3 IF 'ZTSK(0)
QUIT 0
+4 ; Task status is still Active if ZTSK(1)=1 or 2
+5 IF ZTSK(1)=1!(ZTSK(1)=2)
QUIT 1
+6 ; Any other task status means the task is inactive
+7 QUIT 0
+8 ;
BLDSTAT(TEXT) ; Build the report data collection stats email text
+1 IF $GET(STCNT)=""
SET STCNT=0
+2 IF $GET(STGL)=""
SET STGL="^XTMP(""SDVSE"",""RPTSTATS"")"
+3 SET STCNT=STCNT+1
+4 SET @STGL@(0)=""
SET @STGL@(STCNT)=TEXT
+5 QUIT
+6 ;
RPTSTAT ; Report the status of the job
+1 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,TMPDUZ
+2 SET $PIECE(^XTMP("SDECMAIL",0),U)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,)
+3 if $GET(SDECMAIL)'=1
QUIT
+4 SET TMPDUZ=$PIECE($GET(^XTMP("SDECMAIL",0)),U,2)
+5 if 'TMPDUZ
QUIT
+6 SET XMY(TMPDUZ)=""
SET XMSUB="SDEC REPORT DATA Stats for "_$$FMTE^XLFDT($$NOW^XLFDT)
+7 SET XMTEXT=$PIECE(STGL,")")_","
+8 DO ^XMD
+9 ; Reset Purge date for MailMan Status Report user id.
+10 SET $PIECE(^XTMP("SDECMAIL",0),U)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,)
+11 QUIT
+12 ;
EXITOPT ; SD VSE REPORT DATA option exit action
+1 IF '$DATA(IO("Q"))
Begin DoDot:1
+2 IF '$GET(ZTSK)
IF +$PIECE($GET(^XTMP("SDVSE",0)),U,4)
IF $$TSKSTAT($PIECE(^XTMP("SDVSE",0),U,4))
WRITE !!?5,"SD Resource Management Report Data compile has been queued.",!!
DO PAUSE
QUIT
+3 IF '$GET(ZTSK)
IF +$PIECE($GET(^XTMP("SDVSE",0)),U,2)
IF $PIECE($GET(^XTMP("SDVSE",0)),U,5)=""
WRITE !!?5,"SD Resource Management Report Data compile is running",!!
DO PAUSE
+4 IF '$GET(ZTSK)
IF +$PIECE($GET(^XTMP("SDVSE",0)),U,2)
IF +$PIECE($GET(^XTMP("SDVSE",0)),U,5)
WRITE !!?5,"SD Resource Management Report has completed",!!
DO PAUSE
End DoDot:1
QUIT
+5 QUIT
+6 ;
SETDXREF(DA) ; This function is the set condition for the "D" index on the Outpatient Encounter file #409.68
+1 ; This cross reference is only used by the VistA Scheduling GUI Resource Management Reports.
+2 ; The cross reference is used to collect the total Outpatient Encounters for a Provider over a year time period.
+3 ; Verify that all required fields exist before setting cross reference
+4 ; Input: DA = IEN of file 409.68
+5 NEW SDOK,SDEDT,SDLOC,SDVST
SET SDOK=0
+6 ; Don't set index if Date of encounter greater than one year and a day in the past.
+7 SET SDEDT=$PIECE(^SCE(DA,0),U)
IF $$FMDIFF^XLFDT(DT,SDEDT,1)>366
QUIT SDOK
+8 ; Don't set index if this is a Child Encounter
+9 if +$PIECE(^SCE(DA,0),U,6)
QUIT SDOK
+10 ; Don't set if Visit is not defined
+11 SET SDVST=$PIECE(^SCE(DA,0),U,5)
if SDVST=""
QUIT SDOK
+12 ; Don't set index if Encounter Provider is not defined in the V PROVIDER file
+13 if '$ORDER(^AUPNVPRV("AD",+SDVST,0))
QUIT SDOK
+14 ; Don't set index if Location not defined
+15 SET SDLOC=$PIECE(^SCE(DA,0),U,4)
if '$DATA(^SC(+SDLOC))
QUIT SDOK
+16 ; Don't set index if Location is a non-count clinic
+17 if $PIECE($GET(^SC(+SDLOC,0)),"^",17)="Y"
QUIT SDOK
+18 QUIT 1
+19 ;
KILDXREF(DA) ; This function is the kill condition for the "D" index ont he Outpatient Encounter file #409.68
+1 NEW SDOK,SDEDT,SDVST
SET SDOK=1
+2 ; Kill index if date of encounter is greater than one year and a day in the past
+3 SET SDEDT=$PIECE(^SCE(DA,0),U)
IF $$FMDIFF^XLFDT(DT,SDEDT,1)>366
QUIT SDOK
+4 ; Kill index if this is a Child Encounter
+5 if +$PIECE(^SCE(DA,0),U,6)
QUIT SDOK
+6 ; Kill index if Visit is not defined
+7 SET SDVST=$PIECE(^SCE(DA,0),U,5)
if SDVST=""
QUIT SDOK
+8 ; Kill index if Encounter Provider is not defined
+9 if '$ORDER(^AUPNVPRV("AD",+SDVST,0))
QUIT SDOK
+10 ; Kill index if Location not defined
+11 SET SDLOC=$PIECE(^SCE(DA,0),U,4)
if '$DATA(^SC(+SDLOC))
QUIT SDOK
+12 ; Kill index if Location is a non-count clinic
+13 if $PIECE($GET(^SC(+SDLOC,0)),"^",17)="Y"
QUIT SDOK
+14 QUIT 0
+15 ;
PAUSE ;
+1 if $EXTRACT(IOST)'="C"!(IO'=IO(0))
QUIT
+2 NEW DIRUT,DUOUT
+3 SET DIR(0)="EO"
SET DIR("A")="Press return to continue...."
DO ^DIR
KILL DIR
if $DATA(DUOUT)
SET DIRUT=1
+4 QUIT
