SDECXUTL ;DALLAS/JCH - SCHEDULING ENHANCEMENTS 3 UTILITIES ;11/03/14 10:59am
;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
;
PADDT(DATE) ; leading zeroes
N COUNT,STRING,DELIM
S DELIM=$S(DATE["/":"/",DATE["-":"-",1:"")
I DELIM="" Q ""
F COUNT=1:1:$L(DATE,DELIM) S $P(DATE,DELIM,COUNT)=$TR($J($P(DATE,DELIM,COUNT),2)," ",0)
Q DATE
;
HFSOPEN(HANDLE) ; Open file
Q:'$G(SDEBUG)
I SDEBUG=2 S IO=0 Q
N SDDIR,SDFILE,POP,ZX
N SDDEL,SDLIST,SDIN,SDOUT
S SDFILE="SDEC_VSE.XML"
S SDDIR="USER$:[CHEY229]"
S SDIN="SDIN",SDOUT="SDOUT",SDIN(SDFILE)=""
S SDLIST=$$LIST^%ZISH(SDDIR,SDIN,SDOUT)
I SDLIST S ZX=$$DEL^%ZISH(SDDIR,"SDIN")
D OPEN^%ZISH(HANDLE,SDDIR,SDFILE,"W") I 'POP S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF="""""" Q
I POP D Q
.N SDDIR,SDFILE S POP=0
.S SDDIR=$$DEFDIR^%ZISH()
.S SDFILE="sdec_vse.xml"
.D OPEN^%ZISH(HANDLE,SDDIR,SDFILE,"W")
.Q:POP S IOM=132,IOSL=99999
Q
;
HFSCLOSE(HANDLE) ; Close file
Q:'$G(SDEBUG)
Q:($G(SDEBUG)=2)
N SDDIR,SDFILE,SDDEL
D CLOSE^%ZISH(HANDLE)
K ^TMP("SDO",$J)
Q
;
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
;
DIVNAME(DIV) ; Division name
K DIVNAME
I DIV="All" Q DIV
N DIE,DIQ,DIR,DA,X,Y,DIC,DR
S DIQ(0)="I",DIC=40.8,DA=+$G(DIV),DR=".01"
D GETS^DIQ(DIC,DA,DR,"I","DIVNAME")
S DIVNAME=$G(DIVNAME(DIC,DA_",",.01,"I"))
I DIVNAME="" S DIVNAME=$P($$SITE^VASITE,"^",2)
Q $$SYMENC^MXMLUTL(DIVNAME)
;
OUTPUT(TEXT,PAD,SDLCNT,SDEBUG,CLNTAG,GRPFLG,DIVTAG,XMLNODE) ; Generic Set/Output
I $G(XMLNODE)="" S XMLNODE=$S($G(SDFLTFLG):"FLTXML",1:"SDECXML")
I TEXT["/Rg" S GRPFLG=0
I TEXT["/Rs" S CLNTAG=0
I TEXT["/Div" S DIVTAG=0
I TEXT["&" N TMP S TMP=TEXT S TMP=$$PARSE^SDECXML(TEXT,"&","&"),TEXT=TMP
I TEXT["'" N TMP S TMP=TEXT S TMP=$$PARSE^SDECXML(TEXT,"'","'"),TEXT=TMP
S SDLCNT=$G(SDLCNT)+1
I $G(SDEBUG) U IO W:(SDLCNT>1) ! W ?PAD,TEXT
S ^XTMP("SDVSE",XMLNODE,SDLCNT)=TEXT
Q
;
XDATE(DATE,DTINC) ; Date format
N STRING
I DATE["-" D Q XDATE
.N X1,X2
.S X1=$P(DATE,"-"),X2=$P(DATE,"-",2)
.S XDATE=$$PADDT^SDECXUTL($P($$FMTE^XLFDT(X1,5),"@"))_"-"_$$PADDT^SDECXUTL($P($$FMTE^XLFDT(X2,5),"@"))
S XDATE=$$PADDT^SDECXUTL($P($$FMTE^XLFDT(DATE,5),"@"))
Q XDATE
;
BEGEND(DATE,BEGDT,ENDDT,DTINC,SDACTDT) ; Accept activity Date, Set/Write formatted xml with begin and end dates
N XDATE,ZDATE
S BEGDT=DATE,ENDDT=DATE
I DTINC="D" D Q
.S BEGDT=$$XDATE(DATE),ENDDT=$$XDATE(DATE)
I DTINC="W" D Q
.S ENDDT=$$XDATE(DATE),BEGDT=$$XDATE($$FMADD^XLFDT(DATE,-6))
I DTINC="M" D Q
.S BEGDT=$E(DATE,1,5)_"01"
.S ENDDT=$E($$FMADD^XLFDT(BEGDT,32),1,5)_"01",ENDDT=$P($$FMADD^XLFDT(ENDDT,,-1),"@")
.S BEGDT=$$XDATE(BEGDT),ENDDT=$$XDATE(ENDDT)
I DTINC="Y" D Q
.S ENDDT=$$XDATE($$FMADD^XLFDT(SDACTDT,,,1)),BEGDT=$$XDATE($$FMADD^XLFDT(SDACTDT,-365))
I DTINC="Q" D Q
.N QUART,QDATE,QYR
.I $E($P(DATE,"-",2))="Q" S QDATE=$S(DATE["Q1":"0101",DATE["Q2":"0401",DATE["Q3":"0701",DATE["Q4":"1001",1:"") D
..N X,%DT S %DT="I",X=$E(QDATE,1,2)_"/"_$E(QDATE,3,4)_"/"_$P(DATE,"-") D ^%DT I Y S (ZDATE,DATE)=Y
.S QUART=$S(SDDATE'["Q":$$GETQUART^SDCED1(DATE),1:SDDATE)
.S BEGDT=$S(QUART["Q1":"0101",QUART["Q2":"0401",QUART["Q3":"0701",QUART["Q4":"1001",1:"")
.S BEGDT=$E(DATE,1,3)_BEGDT
.S ENDDT=$$FMADD^XLFDT(BEGDT,94),ENDDT=$E(ENDDT,1,5)_"01",ENDDT=$P($$FMADD^XLFDT(ENDDT,,-1),"@")
.S BEGDT=$$XDATE(BEGDT),ENDDT=$$XDATE(ENDDT)
Q
;
NODATA(RESULT,TEXT) ; Return Empty set and queue new build when data build has not run for the day
N SDFAC,SDLCNT,DATINC,SDDATE,SDFILT,XMLNODE
I $G(TEXT)="" S TEXT="Resource Management Report Filters are compiling. Please try again later."
S XMLNODE="NOFLTXML"
S SDEBUG=$G(SDEBUG)
S SDDATE=$$NOW^XLFDT,SDACTDT=$$FMTE^XLFDT(SDDATE)
S SDFAC=$P($$SITE^VASITE,"^",2),SDLCNT=0,DATINC="Date"
D QUEUE^SDCED
D OUTPUT^SDECXUTL("<?xml version=""1.0"" encoding=""UTF-8""?>",0,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
S SDFILT=$$FAC^SDECXML(SDFAC) D SETFILT^SDECXML(.SDLCNT,SDFILT,2)
D OUTPUT^SDECXUTL("<ReportType ReportType="""_TEXT_""">",4,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
D OUTPUT^SDECXUTL("<DateAggregate DateAgg="""">",6,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
D OUTPUT^SDECXUTL("</DateAggregate>",6,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
D OUTPUT^SDECXUTL("</ReportType>",4,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
D OUTPUT^SDECXUTL("</VAFacility>",2,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
S RESULT=$NAME(^XTMP("SDVSE",XMLNODE))
Q
;
SUPPLY(SDSTPAR) ; SUPPLY
I '$D(SDSTPAR) D GETCLNS^SDECSTP(.SDSTPAR)
N GETSUP,SDBDATE,SDECLN,SDEDATE
I $G(SDNODE)="" S SDNODE="SDCEX"
N SDEXCLN,ACTIVE,SSDATE,TMPDT,SUPPLY,SDOW,NXTWK,SDSUPPLY
S SUPPLY="",SDECLN=$G(SDECLN)
S SDEDATE=DT,SDBDATE=$$FMADD^XLFDT(SDEDATE,-365)
S SDEXCLN=$S($G(SDECLN):SDECLN-1,1:0)
F S SDEXCLN=$O(^SC(SDEXCLN)) Q:'SDEXCLN D
. Q:'$$ACTLOC^SDWU(SDEXCLN)
. Q:$$NONCNT^SDCED(SDEXCLN)
. S SDSUPPLY=""
. S TMPDT=$P(SDBDATE,".") F S SDSUPPLY=$$GETSUP2^SDCED2(SDEXCLN,TMPDT) Q:TMPDT>$P(SDEDATE,".") D
. . I $G(SDSUPPLY) D SET(SDEXCLN,TMPDT,SDSUPPLY,.SDSTPAR)
. . S TMPDT=$$FMADD^XLFDT(TMPDT,1)
Q
;
SET(SDEXCLN,TMPDT,SDSUPPLY,SDSTPAR) ; Set supply
N SDSGNM
S SDSGNM="" D GETSCAT^SDCED(SDEXCLN,.SDSGNM,.SDSTPAR) ; Get Stop Code Group Name
Q:SDSGNM="UNKNOWN"
S ^TMP(SDNODE,$J,$E(SDSGNM),+SDEXCLN,TMPDT,0,"APP","SUP")=$FN(SDSUPPLY,",",2)
Q
;
SDGRP(CLN,SDGRP) ; Get external stop code from clinic
N STOPIEN,STOPGRP
S SDGRP=""
S STOPIEN=$$STOPIEN(CLN)
I STOPIEN S SDGRP=$$STOPGRP(STOPIEN)
I SDGRP="" S SDGRP="UNKNOWN"
Q
;
STOPGRP(STP) ; Get Stop Group number
N DIE,DIQ,DIR,DA,X,Y,DIC,DR
S DIQ(0)="I",DIC=40.7,DA=+$G(STP),DR=".01;1"
D GETS^DIQ(DIC,DA,DR,"I","STOPGRP")
S STOPGRP=$G(STOPGRP(DIC,DA_",",1,"I"))
S STOPGRP=STOPGRP_"^"_$G(STOPGRP(DIC,DA_",",.01,"I"))
Q STOPGRP
;
STOPIEN(CLN) ; Get Stop IEN from clinic
N DIE,DIQ,DIR,DA,X,Y,DIC,DR
S DIQ(0)="I",DIC=44,DA=+$G(CLN),DR="8"
D GETS^DIQ(DIC,DA,DR,"I","STOPIEN")
S STOPIEN=$G(STOPIEN(DIC,DA_",",8,"I"))
Q STOPIEN
;
GETSUPM(DATE,RPT) ; Get a months worth of supply for month containing DATE
; ^XTMP("SDCEX","Month","P",3140600,500,"APP","SUP")=543
N FAC,MONTH
S MONTH=$E(DATE,1,5)_"00",FAC=+$$SITE^VASITE
S MONTHSUP=+$G(^XTMP("SDCEX","Month",RPT,MONTH,FAC,"APP","SUP"))
Q MONTHSUP
;
GETDEMM(DATE,RPT) ; Total Monthly Demand
N FAC,MONTH
S MONTH=$E(DATE,1,5)_"00",FAC=+$$SITE^VASITE
S MONTHDEM=+$G(^XTMP("SDCEX","Month",RPT,MONTH,FAC,"APP","DEM"))
Q MONTHDEM
Q
;
SETSDREC(SDLCNT,SDRPTYP,START,XMLNODE) ; Monthly supply and Demand
; Get previous 12 months, write total supply and demand for each month
N TMPDT,X,Y,SDDEM,SDSUP,MONTH,I,MONTHDEM,MONTHSUP
S TMPDT=$S($G(START)?7N:START,1:$$NOW^XLFDT)
D OUTPUT^SDECXUTL("<chartData>",4,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
S MONTH=$E(TMPDT,1,5)_"00"
F I=1:1:12 D
.S SDDEM=$$MONDEM($$GETDEMM(TMPDT,SDRPTYP),MONTH)
.D OUTPUT^SDECXUTL("<"_SDDEM_"/>",5,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
.S SDSUP=$$MONSUP($$GETSUPM(TMPDT,SDRPTYP),MONTH)
.D OUTPUT^SDECXUTL("<"_SDSUP_"/>",5,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
.S TMPDT=$$FMADD^XLFDT(TMPDT,-32)
.S MONTH=$E(TMPDT,1,5)_"00"
D OUTPUT^SDECXUTL("</chartData>",4,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
Q
;
MONDEM(DEM,MONTH,SDLCNT) ; Demand
N TMPMON,TMPLEN
S DEM=DEM/60
S TMPMON=$$FMTE^XLFDT(MONTH,1),TMPLEN=$L(TMPMON)
S TMPMON=$P(TMPMON," ")_"-"_$E(TMPMON,TMPLEN-1,TMPLEN)
S MONTH=TMPMON
S STRING="cR Name=""TotalDemand"" cMonth="""_$$FMTE^XLFDT(MONTH,2)_""" Vt=""Actual"" cVl="""_+$P(DEM,".")_""""
Q STRING
MONSUP(SUP,MONTH) ; Supply
N TMPMON,TMPLEN
S TMPMON=$$FMTE^XLFDT(MONTH,1),TMPLEN=$L(TMPMON)
S TMPMON=$P(TMPMON," ")_"-"_$E(TMPMON,TMPLEN-1,TMPLEN)
S MONTH=TMPMON
S STRING="cR Name=""TotalSupply"" cMonth="""_$$FMTE^XLFDT(MONTH,2)_""" Vt=""Actual"" cVl="""_+$P(SUP,".")_""""
Q STRING
;
GETDIVCL(SDNODE,DATINC,SDRPTYP,SDAT,SDFAC,DIV,DIVCLNAR) ; Get clinics in division DIV
N TMPGRP,TMPCLN
S TMPGRP=0 F S TMPGRP=$O(^XTMP(SDNODE,DATINC,SDRPTYP,SDAT,SDFAC,DIV,TMPGRP)) Q:TMPGRP="" D
.Q:TMPGRP="APP"
.S TMPCLN="" F S TMPCLN=$O(^XTMP(SDNODE,DATINC,SDRPTYP,SDAT,SDFAC,DIV,TMPGRP,TMPCLN)) Q:TMPCLN="" D
..Q:TMPCLN="APP"
..S DIVCLNAR(DIV,TMPCLN)=""
Q
;
DTNAM(DTINC,DTNAM) ; Get date name from abbreviation
S DTNAM=""
N NAME F NAME="Year","Quarter","Month","Week","Date" Q:DTNAM]"" I $E(NAME)=DTINC S DTNAM=NAME
Q
;
;
SDETFM(DATE) ; Convert ext date to fm
N X,Y,DATNAM
S SDINTDT=""
I ($G(DATE)?7N)!($G(DATE)?7N1"."1.N) Q
S X=DATE D ^%DT I Y>0 S SDINTDT=+Y
S DATE=$S($G(SDINTDT):SDINTDT,1:DATE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECXUTL 8962 printed Oct 16, 2024@18:53:43 Page 2
SDECXUTL ;DALLAS/JCH - SCHEDULING ENHANCEMENTS 3 UTILITIES ;11/03/14 10:59am
+1 ;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
+2 ;
PADDT(DATE) ; leading zeroes
+1 NEW COUNT,STRING,DELIM
+2 SET DELIM=$SELECT(DATE["/":"/",DATE["-":"-",1:"")
+3 IF DELIM=""
QUIT ""
+4 FOR COUNT=1:1:$LENGTH(DATE,DELIM)
SET $PIECE(DATE,DELIM,COUNT)=$TRANSLATE($JUSTIFY($PIECE(DATE,DELIM,COUNT),2)," ",0)
+5 QUIT DATE
+6 ;
HFSOPEN(HANDLE) ; Open file
+1 if '$GET(SDEBUG)
QUIT
+2 IF SDEBUG=2
SET IO=0
QUIT
+3 NEW SDDIR,SDFILE,POP,ZX
+4 NEW SDDEL,SDLIST,SDIN,SDOUT
+5 SET SDFILE="SDEC_VSE.XML"
+6 SET SDDIR="USER$:[CHEY229]"
+7 SET SDIN="SDIN"
SET SDOUT="SDOUT"
SET SDIN(SDFILE)=""
+8 SET SDLIST=$$LIST^%ZISH(SDDIR,SDIN,SDOUT)
+9 IF SDLIST
SET ZX=$$DEL^%ZISH(SDDIR,"SDIN")
+10 DO OPEN^%ZISH(HANDLE,SDDIR,SDFILE,"W")
IF 'POP
SET IOM=132
SET IOSL=99999
SET IOST="P-DUMMY"
SET IOF=""""""
QUIT
+11 IF POP
Begin DoDot:1
+12 NEW SDDIR,SDFILE
SET POP=0
+13 SET SDDIR=$$DEFDIR^%ZISH()
+14 SET SDFILE="sdec_vse.xml"
+15 DO OPEN^%ZISH(HANDLE,SDDIR,SDFILE,"W")
+16 if POP
QUIT
SET IOM=132
SET IOSL=99999
End DoDot:1
QUIT
+17 QUIT
+18 ;
HFSCLOSE(HANDLE) ; Close file
+1 if '$GET(SDEBUG)
QUIT
+2 if ($GET(SDEBUG)=2)
QUIT
+3 NEW SDDIR,SDFILE,SDDEL
+4 DO CLOSE^%ZISH(HANDLE)
+5 KILL ^TMP("SDO",$JOB)
+6 QUIT
+7 ;
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 ;
DIVNAME(DIV) ; Division name
+1 KILL DIVNAME
+2 IF DIV="All"
QUIT DIV
+3 NEW DIE,DIQ,DIR,DA,X,Y,DIC,DR
+4 SET DIQ(0)="I"
SET DIC=40.8
SET DA=+$GET(DIV)
SET DR=".01"
+5 DO GETS^DIQ(DIC,DA,DR,"I","DIVNAME")
+6 SET DIVNAME=$GET(DIVNAME(DIC,DA_",",.01,"I"))
+7 IF DIVNAME=""
SET DIVNAME=$PIECE($$SITE^VASITE,"^",2)
+8 QUIT $$SYMENC^MXMLUTL(DIVNAME)
+9 ;
OUTPUT(TEXT,PAD,SDLCNT,SDEBUG,CLNTAG,GRPFLG,DIVTAG,XMLNODE) ; Generic Set/Output
+1 IF $GET(XMLNODE)=""
SET XMLNODE=$SELECT($GET(SDFLTFLG):"FLTXML",1:"SDECXML")
+2 IF TEXT["/Rg"
SET GRPFLG=0
+3 IF TEXT["/Rs"
SET CLNTAG=0
+4 IF TEXT["/Div"
SET DIVTAG=0
+5 IF TEXT["&"
NEW TMP
SET TMP=TEXT
SET TMP=$$PARSE^SDECXML(TEXT,"&","&")
SET TEXT=TMP
+6 IF TEXT["'"
NEW TMP
SET TMP=TEXT
SET TMP=$$PARSE^SDECXML(TEXT,"'","'")
SET TEXT=TMP
+7 SET SDLCNT=$GET(SDLCNT)+1
+8 IF $GET(SDEBUG)
USE IO
if (SDLCNT>1)
WRITE !
WRITE ?PAD,TEXT
+9 SET ^XTMP("SDVSE",XMLNODE,SDLCNT)=TEXT
+10 QUIT
+11 ;
XDATE(DATE,DTINC) ; Date format
+1 NEW STRING
+2 IF DATE["-"
Begin DoDot:1
+3 NEW X1,X2
+4 SET X1=$PIECE(DATE,"-")
SET X2=$PIECE(DATE,"-",2)
+5 SET XDATE=$$PADDT^SDECXUTL($PIECE($$FMTE^XLFDT(X1,5),"@"))_"-"_$$PADDT^SDECXUTL($PIECE($$FMTE^XLFDT(X2,5),"@"))
End DoDot:1
QUIT XDATE
+6 SET XDATE=$$PADDT^SDECXUTL($PIECE($$FMTE^XLFDT(DATE,5),"@"))
+7 QUIT XDATE
+8 ;
BEGEND(DATE,BEGDT,ENDDT,DTINC,SDACTDT) ; Accept activity Date, Set/Write formatted xml with begin and end dates
+1 NEW XDATE,ZDATE
+2 SET BEGDT=DATE
SET ENDDT=DATE
+3 IF DTINC="D"
Begin DoDot:1
+4 SET BEGDT=$$XDATE(DATE)
SET ENDDT=$$XDATE(DATE)
End DoDot:1
QUIT
+5 IF DTINC="W"
Begin DoDot:1
+6 SET ENDDT=$$XDATE(DATE)
SET BEGDT=$$XDATE($$FMADD^XLFDT(DATE,-6))
End DoDot:1
QUIT
+7 IF DTINC="M"
Begin DoDot:1
+8 SET BEGDT=$EXTRACT(DATE,1,5)_"01"
+9 SET ENDDT=$EXTRACT($$FMADD^XLFDT(BEGDT,32),1,5)_"01"
SET ENDDT=$PIECE($$FMADD^XLFDT(ENDDT,,-1),"@")
+10 SET BEGDT=$$XDATE(BEGDT)
SET ENDDT=$$XDATE(ENDDT)
End DoDot:1
QUIT
+11 IF DTINC="Y"
Begin DoDot:1
+12 SET ENDDT=$$XDATE($$FMADD^XLFDT(SDACTDT,,,1))
SET BEGDT=$$XDATE($$FMADD^XLFDT(SDACTDT,-365))
End DoDot:1
QUIT
+13 IF DTINC="Q"
Begin DoDot:1
+14 NEW QUART,QDATE,QYR
+15 IF $EXTRACT($PIECE(DATE,"-",2))="Q"
SET QDATE=$SELECT(DATE["Q1":"0101",DATE["Q2":"0401",DATE["Q3":"0701",DATE["Q4":"1001",1:"")
Begin DoDot:2
+16 NEW X,%DT
SET %DT="I"
SET X=$EXTRACT(QDATE,1,2)_"/"_$EXTRACT(QDATE,3,4)_"/"_$PIECE(DATE,"-")
DO ^%DT
IF Y
SET (ZDATE,DATE)=Y
End DoDot:2
+17 SET QUART=$SELECT(SDDATE'["Q":$$GETQUART^SDCED1(DATE),1:SDDATE)
+18 SET BEGDT=$SELECT(QUART["Q1":"0101",QUART["Q2":"0401",QUART["Q3":"0701",QUART["Q4":"1001",1:"")
+19 SET BEGDT=$EXTRACT(DATE,1,3)_BEGDT
+20 SET ENDDT=$$FMADD^XLFDT(BEGDT,94)
SET ENDDT=$EXTRACT(ENDDT,1,5)_"01"
SET ENDDT=$PIECE($$FMADD^XLFDT(ENDDT,,-1),"@")
+21 SET BEGDT=$$XDATE(BEGDT)
SET ENDDT=$$XDATE(ENDDT)
End DoDot:1
QUIT
+22 QUIT
+23 ;
NODATA(RESULT,TEXT) ; Return Empty set and queue new build when data build has not run for the day
+1 NEW SDFAC,SDLCNT,DATINC,SDDATE,SDFILT,XMLNODE
+2 IF $GET(TEXT)=""
SET TEXT="Resource Management Report Filters are compiling. Please try again later."
+3 SET XMLNODE="NOFLTXML"
+4 SET SDEBUG=$GET(SDEBUG)
+5 SET SDDATE=$$NOW^XLFDT
SET SDACTDT=$$FMTE^XLFDT(SDDATE)
+6 SET SDFAC=$PIECE($$SITE^VASITE,"^",2)
SET SDLCNT=0
SET DATINC="Date"
+7 DO QUEUE^SDCED
+8 DO OUTPUT^SDECXUTL("<?xml version=""1.0"" encoding=""UTF-8""?>",0,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+9 SET SDFILT=$$FAC^SDECXML(SDFAC)
DO SETFILT^SDECXML(.SDLCNT,SDFILT,2)
+10 DO OUTPUT^SDECXUTL("<ReportType ReportType="""_TEXT_""">",4,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+11 DO OUTPUT^SDECXUTL("<DateAggregate DateAgg="""">",6,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+12 DO OUTPUT^SDECXUTL("</DateAggregate>",6,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+13 DO OUTPUT^SDECXUTL("</ReportType>",4,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+14 DO OUTPUT^SDECXUTL("</VAFacility>",2,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+15 SET RESULT=$NAME(^XTMP("SDVSE",XMLNODE))
+16 QUIT
+17 ;
SUPPLY(SDSTPAR) ; SUPPLY
+1 IF '$DATA(SDSTPAR)
DO GETCLNS^SDECSTP(.SDSTPAR)
+2 NEW GETSUP,SDBDATE,SDECLN,SDEDATE
+3 IF $GET(SDNODE)=""
SET SDNODE="SDCEX"
+4 NEW SDEXCLN,ACTIVE,SSDATE,TMPDT,SUPPLY,SDOW,NXTWK,SDSUPPLY
+5 SET SUPPLY=""
SET SDECLN=$GET(SDECLN)
+6 SET SDEDATE=DT
SET SDBDATE=$$FMADD^XLFDT(SDEDATE,-365)
+7 SET SDEXCLN=$SELECT($GET(SDECLN):SDECLN-1,1:0)
+8 FOR
SET SDEXCLN=$ORDER(^SC(SDEXCLN))
if 'SDEXCLN
QUIT
Begin DoDot:1
+9 if '$$ACTLOC^SDWU(SDEXCLN)
QUIT
+10 if $$NONCNT^SDCED(SDEXCLN)
QUIT
+11 SET SDSUPPLY=""
+12 SET TMPDT=$PIECE(SDBDATE,".")
FOR
SET SDSUPPLY=$$GETSUP2^SDCED2(SDEXCLN,TMPDT)
if TMPDT>$PIECE(SDEDATE,".")
QUIT
Begin DoDot:2
+13 IF $GET(SDSUPPLY)
DO SET(SDEXCLN,TMPDT,SDSUPPLY,.SDSTPAR)
+14 SET TMPDT=$$FMADD^XLFDT(TMPDT,1)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
SET(SDEXCLN,TMPDT,SDSUPPLY,SDSTPAR) ; Set supply
+1 NEW SDSGNM
+2 ; Get Stop Code Group Name
SET SDSGNM=""
DO GETSCAT^SDCED(SDEXCLN,.SDSGNM,.SDSTPAR)
+3 if SDSGNM="UNKNOWN"
QUIT
+4 SET ^TMP(SDNODE,$JOB,$EXTRACT(SDSGNM),+SDEXCLN,TMPDT,0,"APP","SUP")=$FNUMBER(SDSUPPLY,",",2)
+5 QUIT
+6 ;
SDGRP(CLN,SDGRP) ; Get external stop code from clinic
+1 NEW STOPIEN,STOPGRP
+2 SET SDGRP=""
+3 SET STOPIEN=$$STOPIEN(CLN)
+4 IF STOPIEN
SET SDGRP=$$STOPGRP(STOPIEN)
+5 IF SDGRP=""
SET SDGRP="UNKNOWN"
+6 QUIT
+7 ;
STOPGRP(STP) ; Get Stop Group number
+1 NEW DIE,DIQ,DIR,DA,X,Y,DIC,DR
+2 SET DIQ(0)="I"
SET DIC=40.7
SET DA=+$GET(STP)
SET DR=".01;1"
+3 DO GETS^DIQ(DIC,DA,DR,"I","STOPGRP")
+4 SET STOPGRP=$GET(STOPGRP(DIC,DA_",",1,"I"))
+5 SET STOPGRP=STOPGRP_"^"_$GET(STOPGRP(DIC,DA_",",.01,"I"))
+6 QUIT STOPGRP
+7 ;
STOPIEN(CLN) ; Get Stop IEN from clinic
+1 NEW DIE,DIQ,DIR,DA,X,Y,DIC,DR
+2 SET DIQ(0)="I"
SET DIC=44
SET DA=+$GET(CLN)
SET DR="8"
+3 DO GETS^DIQ(DIC,DA,DR,"I","STOPIEN")
+4 SET STOPIEN=$GET(STOPIEN(DIC,DA_",",8,"I"))
+5 QUIT STOPIEN
+6 ;
GETSUPM(DATE,RPT) ; Get a months worth of supply for month containing DATE
+1 ; ^XTMP("SDCEX","Month","P",3140600,500,"APP","SUP")=543
+2 NEW FAC,MONTH
+3 SET MONTH=$EXTRACT(DATE,1,5)_"00"
SET FAC=+$$SITE^VASITE
+4 SET MONTHSUP=+$GET(^XTMP("SDCEX","Month",RPT,MONTH,FAC,"APP","SUP"))
+5 QUIT MONTHSUP
+6 ;
GETDEMM(DATE,RPT) ; Total Monthly Demand
+1 NEW FAC,MONTH
+2 SET MONTH=$EXTRACT(DATE,1,5)_"00"
SET FAC=+$$SITE^VASITE
+3 SET MONTHDEM=+$GET(^XTMP("SDCEX","Month",RPT,MONTH,FAC,"APP","DEM"))
+4 QUIT MONTHDEM
+5 QUIT
+6 ;
SETSDREC(SDLCNT,SDRPTYP,START,XMLNODE) ; Monthly supply and Demand
+1 ; Get previous 12 months, write total supply and demand for each month
+2 NEW TMPDT,X,Y,SDDEM,SDSUP,MONTH,I,MONTHDEM,MONTHSUP
+3 SET TMPDT=$SELECT($GET(START)?7N:START,1:$$NOW^XLFDT)
+4 DO OUTPUT^SDECXUTL("<chartData>",4,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+5 SET MONTH=$EXTRACT(TMPDT,1,5)_"00"
+6 FOR I=1:1:12
Begin DoDot:1
+7 SET SDDEM=$$MONDEM($$GETDEMM(TMPDT,SDRPTYP),MONTH)
+8 DO OUTPUT^SDECXUTL("<"_SDDEM_"/>",5,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+9 SET SDSUP=$$MONSUP($$GETSUPM(TMPDT,SDRPTYP),MONTH)
+10 DO OUTPUT^SDECXUTL("<"_SDSUP_"/>",5,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+11 SET TMPDT=$$FMADD^XLFDT(TMPDT,-32)
+12 SET MONTH=$EXTRACT(TMPDT,1,5)_"00"
End DoDot:1
+13 DO OUTPUT^SDECXUTL("</chartData>",4,.SDLCNT,SDEBUG,.CLNTAG,.GRPFLG,.DIVTAG,XMLNODE)
+14 QUIT
+15 ;
MONDEM(DEM,MONTH,SDLCNT) ; Demand
+1 NEW TMPMON,TMPLEN
+2 SET DEM=DEM/60
+3 SET TMPMON=$$FMTE^XLFDT(MONTH,1)
SET TMPLEN=$LENGTH(TMPMON)
+4 SET TMPMON=$PIECE(TMPMON," ")_"-"_$EXTRACT(TMPMON,TMPLEN-1,TMPLEN)
+5 SET MONTH=TMPMON
+6 SET STRING="cR Name=""TotalDemand"" cMonth="""_$$FMTE^XLFDT(MONTH,2)_""" Vt=""Actual"" cVl="""_+$PIECE(DEM,".")_""""
+7 QUIT STRING
MONSUP(SUP,MONTH) ; Supply
+1 NEW TMPMON,TMPLEN
+2 SET TMPMON=$$FMTE^XLFDT(MONTH,1)
SET TMPLEN=$LENGTH(TMPMON)
+3 SET TMPMON=$PIECE(TMPMON," ")_"-"_$EXTRACT(TMPMON,TMPLEN-1,TMPLEN)
+4 SET MONTH=TMPMON
+5 SET STRING="cR Name=""TotalSupply"" cMonth="""_$$FMTE^XLFDT(MONTH,2)_""" Vt=""Actual"" cVl="""_+$PIECE(SUP,".")_""""
+6 QUIT STRING
+7 ;
GETDIVCL(SDNODE,DATINC,SDRPTYP,SDAT,SDFAC,DIV,DIVCLNAR) ; Get clinics in division DIV
+1 NEW TMPGRP,TMPCLN
+2 SET TMPGRP=0
FOR
SET TMPGRP=$ORDER(^XTMP(SDNODE,DATINC,SDRPTYP,SDAT,SDFAC,DIV,TMPGRP))
if TMPGRP=""
QUIT
Begin DoDot:1
+3 if TMPGRP="APP"
QUIT
+4 SET TMPCLN=""
FOR
SET TMPCLN=$ORDER(^XTMP(SDNODE,DATINC,SDRPTYP,SDAT,SDFAC,DIV,TMPGRP,TMPCLN))
if TMPCLN=""
QUIT
Begin DoDot:2
+5 if TMPCLN="APP"
QUIT
+6 SET DIVCLNAR(DIV,TMPCLN)=""
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
DTNAM(DTINC,DTNAM) ; Get date name from abbreviation
+1 SET DTNAM=""
+2 NEW NAME
FOR NAME="Year","Quarter","Month","Week","Date"
if DTNAM]""
QUIT
IF $EXTRACT(NAME)=DTINC
SET DTNAM=NAME
+3 QUIT
+4 ;
+5 ;
SDETFM(DATE) ; Convert ext date to fm
+1 NEW X,Y,DATNAM
+2 SET SDINTDT=""
+3 IF ($GET(DATE)?7N)!($GET(DATE)?7N1"."1.N)
QUIT
+4 SET X=DATE
DO ^%DT
IF Y>0
SET SDINTDT=+Y
+5 SET DATE=$SELECT($GET(SDINTDT):SDINTDT,1:DATE)
+6 QUIT
