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

ECXUTL1.m

Go to the documentation of this file.
  1. ECXUTL1 ;ALB/GTS - Utilities for DSS Extracts ;4/4/19 15:09
  1. ;;3.0;DSS EXTRACTS;**9,49,136,144,149,174**;Dec 22, 1997;Build 33
  1. ;
  1. CYFY(ECXFMDT) ;** Return the calandar and fiscal years for a FM date
  1. ;
  1. ; Input
  1. ; ECXFMDT - Fileman formated date
  1. ;
  1. ; Output
  1. ; X - CY begin date^ CY end date^ FY begin date^ FY end date
  1. ;
  1. N X,Y,Y2
  1. S X=""
  1. S ECXFMDT=$G(ECXFMDT)\1
  1. I ECXFMDT?7N DO
  1. .S (Y,Y2)=$E(ECXFMDT,1,3)
  1. .I $E(ECXFMDT,4,5)>9 S Y2=Y+1
  1. .S X=Y_"0101^"_Y_"1231^"_(Y2-1)_"1001^"_Y2_"0930"
  1. Q X
  1. ;
  1. FISCAL(DATE) ;Return fiscal year
  1. ; Input: DATE = Date (FileMan format) (defaults to today)
  1. ;Output: YYYY = Fiscal year that input date falls within
  1. ;
  1. N YEAR
  1. I '$G(DATE) S DATE=$$DT^XLFDT()
  1. S DATE=$$ECXYM^ECXUTL(DATE)
  1. S YEAR=$E(DATE,1,4)
  1. I $E(DATE,5,6)>9 S YEAR=YEAR+1
  1. Q YEAR
  1. ;
  1. DTRNG() ;** Prompt the user for a date range
  1. ;
  1. N ECXBEG,ECXEND,ECXRNG,ENDRNG
  1. S ECXRNG=0
  1. ;
  1. ;* Prompt for beginning date
  1. W ! S DIR(0)="DA^:DT:EX",DIR("A")="Enter Start Date: "
  1. S DIR("?")="^W ""*** Future dates are not allowed ***"",! D HELP^%DTC"
  1. D ^DIR K DIR
  1. S:'$D(DIRUT) ECXBEG=+Y
  1. K %DT,Y,DTOUT,DUOUT,DIRUT
  1. ;
  1. ;* Prompt for ending date
  1. I $G(ECXBEG) DO
  1. .S ENDRNG=$$CYFY(ECXBEG)
  1. .S ENDRNG=$S($P(ENDRNG,"^",4)<DT:$P(ENDRNG,"^",4),1:DT)
  1. .W ! S DIR(0)="DA^"_ECXBEG_":"_ENDRNG_":EX"
  1. .S DIR("A")="Enter End date: "
  1. .S DIR("?")="^W ""Future dates and dates after the beginning date's FY end are not allowed."",! D HELP^%DTC"
  1. .D ^DIR
  1. .S ECXEND=+Y
  1. .S:'$D(DIRUT) ECXRNG=ECXBEG_"^"_ECXEND
  1. .K DIR,%DT,Y,DIRUT,DTOUT,DUOUT
  1. Q ECXRNG
  1. ;
  1. STRIP(ECXFIELD,ECXLGTH,ECXPOS) ;* Strip blanks from a padded field
  1. ;
  1. ; Input
  1. ; ECXFIELD - Data to remove blanks from
  1. ; ECXLGTH - Total length of padded field
  1. ; ECXPOS - Front or Back indicator ('F' or 'B')
  1. ;
  1. ; Output
  1. ; ECXVAL - Field with blanks removed
  1. ;
  1. N ECXPVAL,QVAL
  1. S:ECXPOS="B" ECXPVAL=ECXLGTH
  1. S:ECXPOS="F" ECXPVAL=1
  1. S QVAL=0
  1. F Q:QVAL DO
  1. .I ECXPOS="B" DO
  1. ..S:($E(ECXFIELD,ECXPVAL)'=" ") QVAL=1
  1. ..S:($E(ECXFIELD,ECXPVAL)=" ") ECXFIELD=$E(ECXFIELD,1,ECXPVAL-1)
  1. ..S ECXPVAL=ECXPVAL-1
  1. ..S:(ECXPVAL<1) QVAL=1
  1. .I ECXPOS="F" DO
  1. ..S:($E(ECXFIELD,1)'=" ") QVAL=1
  1. ..S:($E(ECXFIELD,1)=" ") ECXFIELD=$E(ECXFIELD,2,ECXLGTH-(ECXPVAL-1))
  1. ..S ECXPVAL=ECXPVAL+1
  1. ..S:(ECXPVAL>ECXLGTH) QVAL=1
  1. Q ECXFIELD
  1. ;
  1. PAD(ECXVAL,ECXLGTH,ECXFB,ECXCHAR) ;* Pad the value passed in with ECXCHAR
  1. ;
  1. ; ECXVAL - The value to pad
  1. ; ECXLGTH - The maximum length
  1. ; ECXFB - 'F': Pad on front; 'B' Pad on back
  1. ; ECXCHAR - The character to pad ECXVAL with
  1. ;
  1. ; Output
  1. ; ECXVAR - The padded result
  1. ;
  1. N ECXLPCT,ECXVAR
  1. I $D(ECXVAL),($D(ECXLGTH)),($D(ECXFB)),($D(ECXCHAR)) DO
  1. .S (ECXVAL,ECXVAR)=$E(ECXVAL,1,ECXLGTH)
  1. .F ECXLPCT=1:1:ECXLGTH-$L($E(ECXVAR,1,ECXLGTH)) DO
  1. ..S:ECXFB="B" ECXVAL=ECXVAL_ECXCHAR
  1. ..S:ECXFB="F" ECXVAL=ECXCHAR_ECXVAL
  1. I '$D(ECXVAL) S ECXVAL=""
  1. Q ECXVAL
  1. ;
  1. BLDXREF(START,END) ;Build temporary xref from EDIS LOG file #230 API added in patch 136
  1. N STDT,ENDT,TIME,SITE,IEN,PIEN
  1. S STDT=$$FMADD^XLFDT(START,-1) ;Start day before
  1. S ENDT=$$FMADD^XLFDT(END,1,23,59,59) ;Extend to next day, just before midnight.
  1. S SITE=0 F S SITE=$O(^EDP(230,"ATO",SITE)) Q:'+SITE S TIME=STDT F S TIME=$O(^EDP(230,"ATO",SITE,TIME)) Q:'+TIME!(TIME>ENDT) D
  1. .S IEN=0 F S IEN=$O(^EDP(230,"ATO",SITE,TIME,IEN)) Q:'+IEN S PIEN=$$GET1^DIQ(230,IEN,".06","I") I PIEN S ^TMP($J,"EDIS",PIEN,TIME)=IEN
  1. Q
  1. ;
  1. EDIS(ECXDFN,ECD,ECETYPE,ECXVISIT,ECXSTOP) ;Find emergency room disposition, if it exists, and translate it to a value for DSS. API added with patch 136
  1. N DISP,STDT,DATE,IEN,ENDT
  1. I '+$$VERSION^XPDUTL("EDP") Q "" ;If emergency department software not installed, return null
  1. I ECETYPE="N" Q:ECXSTOP=130 "N" Q "" ;If no-show and ER visit, set to N otherwise set to null
  1. I ECETYPE="A" D Q:'$D(DISP) "" ;If no dispositions found in time frame return null
  1. .S STDT=$$FMADD^XLFDT(ECD,,-24) ;find date/time 24 hours prior to admit date/time
  1. .S ENDT=$$FMADD^XLFDT(ECD,,24) ;add 24 hours to the admit date/time to allow for late entry of disposition following admission
  1. .S DATE=STDT F S DATE=$O(^TMP($J,"EDIS",ECXDFN,DATE)) Q:'+DATE!(DATE>ENDT) S DISP=$$GET1^DIQ(230,^TMP($J,"EDIS",ECXDFN,DATE),1.2,"I")
  1. I ECETYPE="C" Q:$G(ECXSTOP)'=130 "" D
  1. .I +$G(ECXVISIT) S IEN=+$O(^EDP(230,"V",ECXVISIT,0)) ;Check visit file pointer
  1. .I '+$G(IEN) S IEN=+$O(^EDP(230,"B",ECD,0)) I IEN I ECXDFN'=$$GET1^DIQ(230,IEN_",",.06,"I") K IEN ;Check log date/time and patient IEN for match
  1. .I +$G(IEN) S DISP=$$GET1^DIQ(230,IEN,1.2,"I")
  1. I '$D(DISP) Q "N" ;If no visits, return "N" for none
  1. I DISP="" Q "U"
  1. Q $$TRANS(DISP)
  1. ;
  1. TRANS(DISP) ;Translate disposition to set of codes. API added in patch 136
  1. N CODE,DSP
  1. S CODE=$$GET1^DIQ(233.1,DISP_",",".01"),DSP=$$UP^XLFSTR($$GET1^DIQ(233.1,DISP_",",".02")) ;Get code name and display name for disposition
  1. I +CODE Q "U" ;If code begins with a number, it's local
  1. I DSP["ADMIT" Q "A"
  1. I DSP["TRANSFER" Q "T"
  1. I DSP["HOME"!(DSP["AMA")!(DSP["LEFT")!(DSP["ELOPED") Q "L"
  1. I DSP["DECEASED" Q "D"
  1. I DSP["SENT" Q "R"
  1. I DSP["ERROR" Q "E"
  1. Q "U"
  1. ;
  1. ERR ;Send email when scheduling system reports an error. API added in patch 136
  1. N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,I,CNT,TEXT
  1. I '$D(^TMP($J,"SDAMA301")) Q ;No error to report
  1. S XMY($G(DUZ,.5))="" ;Send to user or postmaster if no user identified
  1. S XMY("G.DSS-"_$G(ECGRP))="" ;Include extract group
  1. S XMDUZ="DSS SYSTEM"
  1. S XMSUB="Error in retrieving appointment data during extract"
  1. S CNT=1 S TEXT(CNT)="An error was encountered by the scheduling system during an extract.",CNT=CNT+1
  1. S TEXT(CNT)="The system returned the following error:",CNT=CNT+1,TEXT(CNT)="",CNT=CNT+1
  1. S I=0 F S I=$O(^TMP($J,"SDAMA301",I)) Q:'+I S TEXT(CNT)="Error code "_I_" - "_^TMP($J,"SDAMA301",I)_".",CNT=CNT+1
  1. S TEXT(CNT)="",CNT=CNT+1,TEXT(CNT)="Contact your local I.T. department for assistance."
  1. S XMTEXT="TEXT("
  1. D ^XMD
  1. Q
  1. ;
  1. EXPORT() ;Function indicates if report output is going to a device or to the screen in exportable format - API added in patch 144
  1. N DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y,VAL
  1. W !
  1. S DIR("?",1)="Enter yes if you want the data to be displayed in an '^' delimited format",DIR("?")="that can be captured for exporting."
  1. S DIR(0)="SA^Y:YES;N:NO",DIR("B")="NO",DIR("A")="Do you want the output in exportable format? "
  1. D ^DIR
  1. S VAL=$S($D(DIRUT):-1,Y="N":0,1:1)
  1. I VAL=1 W !!,"Gathering data for export..."
  1. Q VAL
  1. ;
  1. EXPDISP ;Displays report in exportable format. API added in patch 144
  1. N I,%ZIS,POP,DIR,DTOUT,DIRUT,X,Y,DUOUT
  1. I '+$O(^TMP($J,"ECXPORT",0)) W !,"No data found for this report." Q
  1. ;174 Directions for logging have been updated in the following section
  1. W !!,"To ensure all data is captured during the export:"
  1. W !!,"1. In reflections, change the row margin by clicking on one of the change margin",!," icons with a value of 225 or higher if you have them."
  1. W !," You may also set the margin manually by clicking on appearance, expanded",!," terminal settings (arrow in lower right corner), set up display settings."
  1. W !," Scroll to the bottom and change the number of characters per row to 225"
  1. W !," or higher. Click 'OK' to save your change."
  1. W !,"2. Click on 'capture setup' or 'tools, logging (arrow in lower right corner)'",!," depending on your setup. Ensure the logging settings form only has 'to disk'",!," selected and enter"
  1. W " the path and filename where the output should be stored."
  1. W !,"3. Click 'start capture' or 'start logging', depending on your interface."
  1. W !,"4. The DEVICE input for the columns should also contain a large enough",!," parameter (e.g. 225). The DEVICE prompt is defaulted to 0;225;99999 for you.",!," You may change it if need be."
  1. W !,"Example: DEVICE: 0;225;99999 *Where 0 is your screen, 225 is the margin width",!?17,"and 99999 is the screen length."
  1. W !!,"NOTE: In order for all number fields, such as SSN and Feeder Key, to be",!,"displayed correctly in the spreadsheet, these fields must be formatted as Text",!,"when importing the data into the spreadsheet.",!
  1. S %ZIS="",%ZIS("B")="0;225;99999" D ^%ZIS Q:POP
  1. S I="" F S I=$O(^TMP($J,"ECXPORT",I)) Q:I="" W !,^TMP($J,"ECXPORT",I)
  1. W !!,"Click 'stop capture' or 'tools, stop logging' to end logging..." ;174
  1. W !,"...Then, pull your export text file into your spreadsheet.",!
  1. S DIR(0)="E",DIR("A")="Press any key to continue" D ^DIR
  1. D HOME^%ZIS ;set parameters back to normal
  1. Q
  1. ;
  1. REPORTFY(NAME) ;Function added in patch 144, determines which version of the report to run
  1. ;For each report that has a previous fiscal year version, a line label
  1. ;will be added for the report. Following the ;; on the line label is the
  1. ;name of the routine for the previous fiscal year. This value will be
  1. ;returned if the user selects previous fiscal year. The function will
  1. ;return null if current is selected or -1 if no selection is made
  1. N DIR,DIRUT,DTOUT,DUOUT,Y,X,DIROUT
  1. I $T(@NAME)="" Q "" ;No previous FY version exists
  1. W !
  1. S DIR(0)="SA^C:Current Fiscal Year Report Logic;P:Previous Fiscal Year Report Logic",DIR("B")="C",DIR("A")="Use (C)urrent or (P)revious fiscal year logic for this report? "
  1. S DIR("?",1)="This report has been modified for the current fiscal year and may",DIR("?",2)="include additional information or functionality not previously"
  1. S DIR("?",3)="available. If you desire the previous fiscal year logic",DIR("?",4)="to be used then select 'P'. Otherwise, select 'C'"
  1. S DIR("?")="to run the current version of the report."
  1. D ^DIR
  1. I Y="C" Q ""
  1. I Y="P" Q $P($T(@NAME),";;",2)
  1. Q -1 ;User didn't make a selection
  1. ;
  1. ;Reports available for previous fiscal year are listed below as line labels
  1. ;The API^ROUTINE that's part of the line indicates the previous fiscal
  1. ;year entry point and routine to run when "previous" is selected
  1. ;149 updated list to remove previous year's entry
  1. SAMPLE ;;API^ROUTINE