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