- 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 Jan 18, 2025@02:55:36 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