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

SDECXUTL.m

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