- 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 Feb 19, 2025@00:19:35 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