RCDMCUT2 ;HEC/SBW - Utility Functions for Hold Debt to DMC Project ;30/AUG/2007
;;4.5;Accounts Receivable;**253,347**;Mar 20, 1995;Build 47
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
DEVICE(ROUTINE,DESC,STOPIT,RCSCR,BEGDT,EXCEL,RCTYPE,RCDMC) ;
;INPUT:
; ROUTINE - Routine Entry to Queue (e.g. MAIN^RDDMCR1)
; DESC - Description to use for tasked jobs
; BEGDT - Beginning date the report should begin with (required)
; EXCEL - If 1 report format will be Excel Delimited (Optional)
; RCTYPE - Report Type - D-DETAILED,S-SUMMARY,E-Excel (Optional)
; RCDMC - DMC Debt Valid Field Value - A-ALL VALUES,B-BLANK/NULL,
; Y-YES,N-NO (Optional)
;OUTPUT:
; STOPIT - Variable to indicate if process should't continue
; RCSCR - Variable to indicate if process is being sent to
; the screen or a device. 1 indicate screen
;
N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,POP,ZTSAVE
I $G(ROUTINE)']"" S STOPIT=1 Q
I $G(BEGDT)']"" S STOPIT=1 Q
S %ZIS="QM"
W ! D ^%ZIS
I POP S STOPIT=1 Q
S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
;
I $D(IO("Q")) D S STOPIT=1
. S ZTRTN=ROUTINE
. S ZTIO=ION
. S ZTSAVE("RC*")=""
. S ZTSAVE("STOPIT")=""
. S ZTSAVE("BEGDT")=""
. S ZTSAVE("EXCEL")=""
. S ZTDESC=$G(DESC)
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Request Queued. TASK = "_ZTSK,1:"REQUEST CANCELLED")
. D HOME^%ZIS
Q
;
STOPIT() ; Checks if user requested task to stop
;Input:
; No input
;Output
; Function returns one if the user requested the task to stop
;
N RCX,STOPIT
S STOPIT=0
S RCX=$$S^%ZTLOAD
I RCX D ;
. S STOPIT=1
. I $G(ZTSK) S ZTSTOP=1
Q STOPIT
;
EXCEL() ; - Returns whether to capture data for Excel report.
;INPUT:
; None
; Output:
; Returns 1 - YES (capture data) / 0 - NO (DO NOT capture data) /
; "^" - Exit report
;
N EXCEL,X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
;
S EXCEL=0
S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
S DIR("A")="Do you want to capture report data for an Excel document"
S DIR("?")="^D HEXC^RCDMCUT2"
D ^DIR
S:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) EXCEL="^"
S:$G(Y)>0 EXCEL=1
;
Q EXCEL
;
HEXC ; - 'Do you want to capture data...' prompt
W !!," Enter: 'Y' - To capture detail report data to transfer"
W !," to an Excel document"
W !," '<CR>' - To skip this option"
W !," '^' - To quit this option"
Q
;
EXMSG ; - Displays the message about capturing to an Excel file format
;
W !!?5,"This report may take a while to run. It is recommended that you Queue it."
W !!?5,"To capture as an Excel format, it is recommended that you queue this"
W !?5,"report to a spool device with margins of 256 and page length of 99999"
W !?5,"(e.g. spoolname;256;99999). This should help avoid wrapping problems."
W !!?5,"Another method would be to set up your terminal to capture the detail"
W !?5,"report data. On some terminals, this can be done by clicking on the"
W !?5,"'Tools' menu above, then click on 'Capture Incoming Data' to save to"
W !?5,"Desktop. To avoid undesired wrapping of the data saved to the file,"
W !?5,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
Q
;
GETTYPE(STOPIT) ; Choose a (S)ummary or (D)etail or (E)xcel Delimited Report
;INPUT
; STOPIT - Variable to be set if user '^' out or time out
;OUTPUT
; STOPIT - Variable to be set if user '^' out or time out
; Function returns the Report Type (D,S,E)
;
N Y,X,DIR,DIRUT,DUOUT,DTOUT,DIROUT
S DIR(0)="S^D:DETAILED;S:SUMMARY;E:EXCEL DELIMITED"
S DIR("A")="Select Type of Report"
W !
D ^DIR
S:$D(DIRUT)!$D(DUOUT)!$D(DTOUT)!$D(DIROUT) STOPIT=1,Y=""
Q Y
GETTYPE2(STOPIT) ; Choose a (S)ummary or (D)etail
;INPUT
; STOPIT - Variable to be set if user '^' out or time out
;OUTPUT
; STOPIT - Variable to be set if user '^' out or time out
; Function returns the Report Type (D,S,E)
;
N Y,X,DIR,DIRUT,DUOUT,DTOUT,DIROUT
S DIR(0)="S^D:DETAILED;S:SUMMARY"
S DIR("A")="Select Type of Report"
S DIR("B")="DETAILED"
W !
D ^DIR
S:$D(DIRUT)!$D(DUOUT)!$D(DTOUT)!$D(DIROUT) STOPIT=1,Y=""
Q $E(Y)
;
BILLPAYS() ; Do you want to see only bills with payments?
;INPUT:
; None
; Output:
; Returns 1 - YES (Bills with payments) / 0 - NO (All bills) /
; "^" - Exit report
;
N BP,X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
;
S BP=0
S DIR(0)="Y",DIR("B")="YES",DIR("T")=DTIME W !
S DIR("A")="Do you want to see only bills with payments"
;S DIR("?")="^D HEXC^RCDMCUT2"
D ^DIR
S:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) BP="^"
S:$G(Y)>0 BP=1
Q BP
;
GETDMC(STOPIT) ;Chose DMC Debt Valid field value to include Null, Pending,
; Yes, No and All vallues
;INPUT
; STOPIT - Variable to be set if user '^' out or time out
;OUTPUT
; STOPIT - Variable to be set if user '^' out or time out
; Function returns the DMC Debt Valid Field Value (A,B,P,Y,N)
;
N Y,X,DIR,DIRUT,DUOUT,DTOUT,DIROUT
S DIR(0)="S^A:ALL FIELD VALUES;B:BLANK/NULL;P:PENDING;Y:YES;N:NO"
S DIR("A")="Select DMC Debt Valid field value"
S DIR("?")=" "
S DIR("?",1)="Enter 'A' to list bills of all DMC Debt Valid values"
S DIR("?",2)="Enter 'B' to list bills not yet reviewed by the user"
S DIR("?",3)="Enter 'P' to list bills excluded by AR nightly background process"
S DIR("?",4)="Enter 'Y' to list bills a User determined should be referred to DMC"
S DIR("?",5)="Enter 'N' to list bills a User determined should not be referred to DMC"
W !
D ^DIR
S:$D(DIRUT)!$D(DUOUT)!$D(DTOUT)!$D(DIROUT) STOPIT=1,Y=""
Q Y
;
EXTTYPE(TYPE) ;Get Set of Code external format for Report type
;INPUT
; TYPE - Internal Report type: D, S, E
;OUTPUT
; Returns external Report type: D - DETAILED, S - SUMMARY,
; E - EXCEL DELIMITED
;
S TYPE=$G(TYPE)
Q $S(TYPE="D":"DETAILED",TYPE="S":"SUMMARY",TYPE="E":"EXCEL DELIMITED",1:"")
;
EXTDMC(VAL) ;Get Set of Code external format for DMC Debt Valid field value
;INPUT
; VAL - Internal DMC Debt Valid value: A, B, P, Y, N
;OUTPUT
; Returns external DMC Debt Valid value: A - ALL, B - BLANK/NULL
; P - PENDING, Y - YES, N - NO
;
S VAL=$G(VAL)
Q $S(VAL="A":"ALL",VAL="B":"BLANK/NULL",VAL="P":"PENDING",VAL="Y":"YES",VAL="N":"NO",1:"")
;
DATE(PROMPT,PROMPT2,BEG,END,DTYPE) ;Get beginning and Ending dates
;INPUT:
; PROMPT - Message to display prior to prompting for dates
; PROMPT2 - (Optional) Message to display on second line
; BEG - (Optional) default begin date
; END - (Optional) default end date
; DTYPE - (Optional) date type
;OUTPUT:
; 1^BEGDT^ENDDT - Data found
; 0 - User up arrowed or timed out
;NOTE:
; Optional Parameters added by Glaz to support date range from other reports
;
N %DT,Y,X,BEGDT,ENDDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT
S OUT=0
W !,$G(PROMPT)
I $G(PROMPT2)'="" W !,$G(PROMPT2)
S %DT="AEX"
S %DT("A")="Enter "_$S($G(DTYPE)="":"",1:DTYPE_" ")_"Beginning Date: "
I $G(BEG)="" S %DT("B")="TODAY"
E S Y=BEG X ^DD("DD") S %DT("B")=Y
W !
D ^%DT
K %DT
;Quit if user time out or didn't enter valid date
Q:Y<0 OUT
S BEGDT=+Y
S %DT="AEX"
S %DT("A")="Enter "_$S($G(DTYPE)="":"",1:DTYPE_" ")_"Ending Date: "
I $G(END)="" S %DT("B")="TODAY"
E S Y=END X ^DD("DD") S %DT("B")=Y
D ^%DT
K %DT
;Quit if user time out or didn't enter valid date
Q:Y<0 OUT
S ENDDT=+Y
S OUT=1_U_BEGDT_U_ENDDT
;Switch dates when user enters more recent date for Begin Date
;than End Date
S:BEGDT>ENDDT OUT=1_U_ENDDT_U_BEGDT
Q OUT
;
DATE2(PROMPT,PROMPT2,BEG,END,DTYPE) ;Get beginning and Ending dates
;INPUT:
; PROMPT - Message to display prior to prompting for dates
; PROMPT2 - (Optional) Message to display on second line
; BEG - (Optional) default begin date
; END - (Optional) default end date
; DTYPE - (Optional) date type
;OUTPUT:
; 1^BEGDT^ENDDT - Data found
; 0 - User up arrowed or timed out
;NOTE:
; Optional Parameters added to support date range from other reports
;
N %DT,Y,X,BEGDT,ENDDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT
S OUT=0
W !,$G(PROMPT)
I $G(PROMPT2)'="" W !,$G(PROMPT2)
S %DT="AEX"
S %DT("A")="Enter "_$S($G(DTYPE)="":"",1:DTYPE_" ")_"Begin Date: "
I $G(BEG)="" S %DT("B")="TODAY"
I $G(BEG)'="" S Y=BEG X ^DD("DD") S %DT("B")=Y
W !
D ^%DT
K %DT
;Quit if user time out or didn't enter valid date
Q:Y<0 OUT
S BEGDT=+Y
S %DT="AEX"
S %DT("A")="Enter "_$S($G(DTYPE)="":"",1:DTYPE_" ")_"End Date: "
I $G(END)="" S %DT("B")="TODAY"
I $G(END)'="" S Y=END X ^DD("DD") S %DT("B")=Y
D ^%DT
K %DT
;Quit if user time out or didn't enter valid date
Q:Y<0 OUT
S ENDDT=+Y
S OUT=1_U_BEGDT_U_ENDDT
;Switch dates when user enters more recent date for Begin Date
;than End Date
S:BEGDT>ENDDT OUT=1_U_ENDDT_U_BEGDT
Q OUT
;
GETBEGDT(PROMPT1,PROMPT2,DTPROMPT) ;Get beginning date
;INPUT:
; PROMPT1 - Message to display prior to prompting for date
; PROMPT2 - Message to display prior to prompting for date
; DTPROMPT - Date query verbiage, if defined
;OUTPUT:
; 1^BEGDT - Data found
; 0 - User up arrowed or timed out
;
N %DT,Y,X,BEGDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT
S OUT=0
W !!,$G(PROMPT1)
W:$G(PROMPT2)]"" !,PROMPT2
S %DT="AEX"
S %DT("A")="Enter Beginning Date: " I $G(DTPROMPT)]"" S %DT("A")=DTPROMPT
S %DT("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365,0,0,0),"1D")
S %DT(0)=-$$FMADD^XLFDT(DT,-365,0,0,0)
W !
D ^%DT
K %DT
;Quit if user time out or didn't enter valid date
Q:Y<0 OUT
S BEGDT=+Y
S OUT=1_U_BEGDT
Q OUT
ARSTAT(STOPIT) ;Chose AR status
; Yes, No and All vallues
;INPUT
; STOPIT - Variable to be set if user '^' out or time out
;OUTPUT
; STOPIT - Variable to be set if user '^' out or time out
; Function returns 1-7 (1:Active;2:Open;3:Suspended;4:Collected/Closed;5:On-Hold;6:Write Off;7:All)
;
N Y,X,DIR,DIRUT,DUOUT,DTOUT,DIROUT
;W !,"Report to Include Bills for charges without an IB status of Cancelled, with an"
;W !,"AR Status of Active, Open, Suspended, Write-Off, Collected/Closed, or with IB"
;W !,"Status of On-Hold, and date of service on or after the exemption effective date."
S DIR(0)="S^1:Active;2:Open;3:Suspended;4:Collected/Closed;5:On-Hold;6:Write-Off;7:ALL (Includes 1-6 and AR CANCELLATIONS)"
S DIR("A")="Select a Status"
S DIR("B")=7
W !
D ^DIR
S:$D(DIRUT)!$D(DUOUT)!$D(DTOUT)!$D(DIROUT) STOPIT=1,Y=""
Q Y
;
PAUSE ;If sending report to screen display pause message at screen bottom
N X
U IO(0)
W !!,"Press RETURN to continue, '^' to exit:"
R X:DTIME
S:'$T X="^"
S:X["^" STOPIT=2
U IO
Q
;
PAUSE2 ;If sending report to screen display pause message at screen bottom;
N X
U IO(0)
W !!,"Press RETURN to continue:"
R X:DTIME
S:'$T X="^"
S:X["^" STOPIT=2
U IO
Q
;
ULINE(X,WIDTH) ;Display line of a given character
;INPUT:
; X - Character to display
; WIDTH - Number of Character to display
;
N I
S:$G(WIDTH)'>0 WIDTH=80
W !
F I=1:1:WIDTH W $G(X,"-")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCUT2 11267 printed Jan 18, 2025@02:45 Page 2
RCDMCUT2 ;HEC/SBW - Utility Functions for Hold Debt to DMC Project ;30/AUG/2007
+1 ;;4.5;Accounts Receivable;**253,347**;Mar 20, 1995;Build 47
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
DEVICE(ROUTINE,DESC,STOPIT,RCSCR,BEGDT,EXCEL,RCTYPE,RCDMC) ;
+1 ;INPUT:
+2 ; ROUTINE - Routine Entry to Queue (e.g. MAIN^RDDMCR1)
+3 ; DESC - Description to use for tasked jobs
+4 ; BEGDT - Beginning date the report should begin with (required)
+5 ; EXCEL - If 1 report format will be Excel Delimited (Optional)
+6 ; RCTYPE - Report Type - D-DETAILED,S-SUMMARY,E-Excel (Optional)
+7 ; RCDMC - DMC Debt Valid Field Value - A-ALL VALUES,B-BLANK/NULL,
+8 ; Y-YES,N-NO (Optional)
+9 ;OUTPUT:
+10 ; STOPIT - Variable to indicate if process should't continue
+11 ; RCSCR - Variable to indicate if process is being sent to
+12 ; the screen or a device. 1 indicate screen
+13 ;
+14 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,POP,ZTSAVE
+15 IF $GET(ROUTINE)']""
SET STOPIT=1
QUIT
+16 IF $GET(BEGDT)']""
SET STOPIT=1
QUIT
+17 SET %ZIS="QM"
+18 WRITE !
DO ^%ZIS
+19 IF POP
SET STOPIT=1
QUIT
+20 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+21 ;
+22 IF $DATA(IO("Q"))
Begin DoDot:1
+23 SET ZTRTN=ROUTINE
+24 SET ZTIO=ION
+25 SET ZTSAVE("RC*")=""
+26 SET ZTSAVE("STOPIT")=""
+27 SET ZTSAVE("BEGDT")=""
+28 SET ZTSAVE("EXCEL")=""
+29 SET ZTDESC=$GET(DESC)
+30 DO ^%ZTLOAD
+31 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued. TASK = "_ZTSK,1:"REQUEST CANCELLED")
+32 DO HOME^%ZIS
End DoDot:1
SET STOPIT=1
+33 QUIT
+34 ;
STOPIT() ; Checks if user requested task to stop
+1 ;Input:
+2 ; No input
+3 ;Output
+4 ; Function returns one if the user requested the task to stop
+5 ;
+6 NEW RCX,STOPIT
+7 SET STOPIT=0
+8 SET RCX=$$S^%ZTLOAD
+9 ;
IF RCX
Begin DoDot:1
+10 SET STOPIT=1
+11 IF $GET(ZTSK)
SET ZTSTOP=1
End DoDot:1
+12 QUIT STOPIT
+13 ;
EXCEL() ; - Returns whether to capture data for Excel report.
+1 ;INPUT:
+2 ; None
+3 ; Output:
+4 ; Returns 1 - YES (capture data) / 0 - NO (DO NOT capture data) /
+5 ; "^" - Exit report
+6 ;
+7 NEW EXCEL,X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
+8 ;
+9 SET EXCEL=0
+10 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("T")=DTIME
WRITE !
+11 SET DIR("A")="Do you want to capture report data for an Excel document"
+12 SET DIR("?")="^D HEXC^RCDMCUT2"
+13 DO ^DIR
+14 if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET EXCEL="^"
+15 if $GET(Y)>0
SET EXCEL=1
+16 ;
+17 QUIT EXCEL
+18 ;
HEXC ; - 'Do you want to capture data...' prompt
+1 WRITE !!," Enter: 'Y' - To capture detail report data to transfer"
+2 WRITE !," to an Excel document"
+3 WRITE !," '<CR>' - To skip this option"
+4 WRITE !," '^' - To quit this option"
+5 QUIT
+6 ;
EXMSG ; - Displays the message about capturing to an Excel file format
+1 ;
+2 WRITE !!?5,"This report may take a while to run. It is recommended that you Queue it."
+3 WRITE !!?5,"To capture as an Excel format, it is recommended that you queue this"
+4 WRITE !?5,"report to a spool device with margins of 256 and page length of 99999"
+5 WRITE !?5,"(e.g. spoolname;256;99999). This should help avoid wrapping problems."
+6 WRITE !!?5,"Another method would be to set up your terminal to capture the detail"
+7 WRITE !?5,"report data. On some terminals, this can be done by clicking on the"
+8 WRITE !?5,"'Tools' menu above, then click on 'Capture Incoming Data' to save to"
+9 WRITE !?5,"Desktop. To avoid undesired wrapping of the data saved to the file,"
+10 WRITE !?5,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
+11 QUIT
+12 ;
GETTYPE(STOPIT) ; Choose a (S)ummary or (D)etail or (E)xcel Delimited Report
+1 ;INPUT
+2 ; STOPIT - Variable to be set if user '^' out or time out
+3 ;OUTPUT
+4 ; STOPIT - Variable to be set if user '^' out or time out
+5 ; Function returns the Report Type (D,S,E)
+6 ;
+7 NEW Y,X,DIR,DIRUT,DUOUT,DTOUT,DIROUT
+8 SET DIR(0)="S^D:DETAILED;S:SUMMARY;E:EXCEL DELIMITED"
+9 SET DIR("A")="Select Type of Report"
+10 WRITE !
+11 DO ^DIR
+12 if $DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
SET STOPIT=1
SET Y=""
+13 QUIT Y
GETTYPE2(STOPIT) ; Choose a (S)ummary or (D)etail
+1 ;INPUT
+2 ; STOPIT - Variable to be set if user '^' out or time out
+3 ;OUTPUT
+4 ; STOPIT - Variable to be set if user '^' out or time out
+5 ; Function returns the Report Type (D,S,E)
+6 ;
+7 NEW Y,X,DIR,DIRUT,DUOUT,DTOUT,DIROUT
+8 SET DIR(0)="S^D:DETAILED;S:SUMMARY"
+9 SET DIR("A")="Select Type of Report"
+10 SET DIR("B")="DETAILED"
+11 WRITE !
+12 DO ^DIR
+13 if $DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
SET STOPIT=1
SET Y=""
+14 QUIT $EXTRACT(Y)
+15 ;
BILLPAYS() ; Do you want to see only bills with payments?
+1 ;INPUT:
+2 ; None
+3 ; Output:
+4 ; Returns 1 - YES (Bills with payments) / 0 - NO (All bills) /
+5 ; "^" - Exit report
+6 ;
+7 NEW BP,X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT
+8 ;
+9 SET BP=0
+10 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("T")=DTIME
WRITE !
+11 SET DIR("A")="Do you want to see only bills with payments"
+12 ;S DIR("?")="^D HEXC^RCDMCUT2"
+13 DO ^DIR
+14 if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BP="^"
+15 if $GET(Y)>0
SET BP=1
+16 QUIT BP
+17 ;
GETDMC(STOPIT) ;Chose DMC Debt Valid field value to include Null, Pending,
+1 ; Yes, No and All vallues
+2 ;INPUT
+3 ; STOPIT - Variable to be set if user '^' out or time out
+4 ;OUTPUT
+5 ; STOPIT - Variable to be set if user '^' out or time out
+6 ; Function returns the DMC Debt Valid Field Value (A,B,P,Y,N)
+7 ;
+8 NEW Y,X,DIR,DIRUT,DUOUT,DTOUT,DIROUT
+9 SET DIR(0)="S^A:ALL FIELD VALUES;B:BLANK/NULL;P:PENDING;Y:YES;N:NO"
+10 SET DIR("A")="Select DMC Debt Valid field value"
+11 SET DIR("?")=" "
+12 SET DIR("?",1)="Enter 'A' to list bills of all DMC Debt Valid values"
+13 SET DIR("?",2)="Enter 'B' to list bills not yet reviewed by the user"
+14 SET DIR("?",3)="Enter 'P' to list bills excluded by AR nightly background process"
+15 SET DIR("?",4)="Enter 'Y' to list bills a User determined should be referred to DMC"
+16 SET DIR("?",5)="Enter 'N' to list bills a User determined should not be referred to DMC"
+17 WRITE !
+18 DO ^DIR
+19 if $DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
SET STOPIT=1
SET Y=""
+20 QUIT Y
+21 ;
EXTTYPE(TYPE) ;Get Set of Code external format for Report type
+1 ;INPUT
+2 ; TYPE - Internal Report type: D, S, E
+3 ;OUTPUT
+4 ; Returns external Report type: D - DETAILED, S - SUMMARY,
+5 ; E - EXCEL DELIMITED
+6 ;
+7 SET TYPE=$GET(TYPE)
+8 QUIT $SELECT(TYPE="D":"DETAILED",TYPE="S":"SUMMARY",TYPE="E":"EXCEL DELIMITED",1:"")
+9 ;
EXTDMC(VAL) ;Get Set of Code external format for DMC Debt Valid field value
+1 ;INPUT
+2 ; VAL - Internal DMC Debt Valid value: A, B, P, Y, N
+3 ;OUTPUT
+4 ; Returns external DMC Debt Valid value: A - ALL, B - BLANK/NULL
+5 ; P - PENDING, Y - YES, N - NO
+6 ;
+7 SET VAL=$GET(VAL)
+8 QUIT $SELECT(VAL="A":"ALL",VAL="B":"BLANK/NULL",VAL="P":"PENDING",VAL="Y":"YES",VAL="N":"NO",1:"")
+9 ;
DATE(PROMPT,PROMPT2,BEG,END,DTYPE) ;Get beginning and Ending dates
+1 ;INPUT:
+2 ; PROMPT - Message to display prior to prompting for dates
+3 ; PROMPT2 - (Optional) Message to display on second line
+4 ; BEG - (Optional) default begin date
+5 ; END - (Optional) default end date
+6 ; DTYPE - (Optional) date type
+7 ;OUTPUT:
+8 ; 1^BEGDT^ENDDT - Data found
+9 ; 0 - User up arrowed or timed out
+10 ;NOTE:
+11 ; Optional Parameters added by Glaz to support date range from other reports
+12 ;
+13 NEW %DT,Y,X,BEGDT,ENDDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT
+14 SET OUT=0
+15 WRITE !,$GET(PROMPT)
+16 IF $GET(PROMPT2)'=""
WRITE !,$GET(PROMPT2)
+17 SET %DT="AEX"
+18 SET %DT("A")="Enter "_$SELECT($GET(DTYPE)="":"",1:DTYPE_" ")_"Beginning Date: "
+19 IF $GET(BEG)=""
SET %DT("B")="TODAY"
+20 IF '$TEST
SET Y=BEG
XECUTE ^DD("DD")
SET %DT("B")=Y
+21 WRITE !
+22 DO ^%DT
+23 KILL %DT
+24 ;Quit if user time out or didn't enter valid date
+25 if Y<0
QUIT OUT
+26 SET BEGDT=+Y
+27 SET %DT="AEX"
+28 SET %DT("A")="Enter "_$SELECT($GET(DTYPE)="":"",1:DTYPE_" ")_"Ending Date: "
+29 IF $GET(END)=""
SET %DT("B")="TODAY"
+30 IF '$TEST
SET Y=END
XECUTE ^DD("DD")
SET %DT("B")=Y
+31 DO ^%DT
+32 KILL %DT
+33 ;Quit if user time out or didn't enter valid date
+34 if Y<0
QUIT OUT
+35 SET ENDDT=+Y
+36 SET OUT=1_U_BEGDT_U_ENDDT
+37 ;Switch dates when user enters more recent date for Begin Date
+38 ;than End Date
+39 if BEGDT>ENDDT
SET OUT=1_U_ENDDT_U_BEGDT
+40 QUIT OUT
+41 ;
DATE2(PROMPT,PROMPT2,BEG,END,DTYPE) ;Get beginning and Ending dates
+1 ;INPUT:
+2 ; PROMPT - Message to display prior to prompting for dates
+3 ; PROMPT2 - (Optional) Message to display on second line
+4 ; BEG - (Optional) default begin date
+5 ; END - (Optional) default end date
+6 ; DTYPE - (Optional) date type
+7 ;OUTPUT:
+8 ; 1^BEGDT^ENDDT - Data found
+9 ; 0 - User up arrowed or timed out
+10 ;NOTE:
+11 ; Optional Parameters added to support date range from other reports
+12 ;
+13 NEW %DT,Y,X,BEGDT,ENDDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT
+14 SET OUT=0
+15 WRITE !,$GET(PROMPT)
+16 IF $GET(PROMPT2)'=""
WRITE !,$GET(PROMPT2)
+17 SET %DT="AEX"
+18 SET %DT("A")="Enter "_$SELECT($GET(DTYPE)="":"",1:DTYPE_" ")_"Begin Date: "
+19 IF $GET(BEG)=""
SET %DT("B")="TODAY"
+20 IF $GET(BEG)'=""
SET Y=BEG
XECUTE ^DD("DD")
SET %DT("B")=Y
+21 WRITE !
+22 DO ^%DT
+23 KILL %DT
+24 ;Quit if user time out or didn't enter valid date
+25 if Y<0
QUIT OUT
+26 SET BEGDT=+Y
+27 SET %DT="AEX"
+28 SET %DT("A")="Enter "_$SELECT($GET(DTYPE)="":"",1:DTYPE_" ")_"End Date: "
+29 IF $GET(END)=""
SET %DT("B")="TODAY"
+30 IF $GET(END)'=""
SET Y=END
XECUTE ^DD("DD")
SET %DT("B")=Y
+31 DO ^%DT
+32 KILL %DT
+33 ;Quit if user time out or didn't enter valid date
+34 if Y<0
QUIT OUT
+35 SET ENDDT=+Y
+36 SET OUT=1_U_BEGDT_U_ENDDT
+37 ;Switch dates when user enters more recent date for Begin Date
+38 ;than End Date
+39 if BEGDT>ENDDT
SET OUT=1_U_ENDDT_U_BEGDT
+40 QUIT OUT
+41 ;
GETBEGDT(PROMPT1,PROMPT2,DTPROMPT) ;Get beginning date
+1 ;INPUT:
+2 ; PROMPT1 - Message to display prior to prompting for date
+3 ; PROMPT2 - Message to display prior to prompting for date
+4 ; DTPROMPT - Date query verbiage, if defined
+5 ;OUTPUT:
+6 ; 1^BEGDT - Data found
+7 ; 0 - User up arrowed or timed out
+8 ;
+9 NEW %DT,Y,X,BEGDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT
+10 SET OUT=0
+11 WRITE !!,$GET(PROMPT1)
+12 if $GET(PROMPT2)]""
WRITE !,PROMPT2
+13 SET %DT="AEX"
+14 SET %DT("A")="Enter Beginning Date: "
IF $GET(DTPROMPT)]""
SET %DT("A")=DTPROMPT
+15 SET %DT("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365,0,0,0),"1D")
+16 SET %DT(0)=-$$FMADD^XLFDT(DT,-365,0,0,0)
+17 WRITE !
+18 DO ^%DT
+19 KILL %DT
+20 ;Quit if user time out or didn't enter valid date
+21 if Y<0
QUIT OUT
+22 SET BEGDT=+Y
+23 SET OUT=1_U_BEGDT
+24 QUIT OUT
ARSTAT(STOPIT) ;Chose AR status
+1 ; Yes, No and All vallues
+2 ;INPUT
+3 ; STOPIT - Variable to be set if user '^' out or time out
+4 ;OUTPUT
+5 ; STOPIT - Variable to be set if user '^' out or time out
+6 ; Function returns 1-7 (1:Active;2:Open;3:Suspended;4:Collected/Closed;5:On-Hold;6:Write Off;7:All)
+7 ;
+8 NEW Y,X,DIR,DIRUT,DUOUT,DTOUT,DIROUT
+9 ;W !,"Report to Include Bills for charges without an IB status of Cancelled, with an"
+10 ;W !,"AR Status of Active, Open, Suspended, Write-Off, Collected/Closed, or with IB"
+11 ;W !,"Status of On-Hold, and date of service on or after the exemption effective date."
+12 SET DIR(0)="S^1:Active;2:Open;3:Suspended;4:Collected/Closed;5:On-Hold;6:Write-Off;7:ALL (Includes 1-6 and AR CANCELLATIONS)"
+13 SET DIR("A")="Select a Status"
+14 SET DIR("B")=7
+15 WRITE !
+16 DO ^DIR
+17 if $DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
SET STOPIT=1
SET Y=""
+18 QUIT Y
+19 ;
PAUSE ;If sending report to screen display pause message at screen bottom
+1 NEW X
+2 USE IO(0)
+3 WRITE !!,"Press RETURN to continue, '^' to exit:"
+4 READ X:DTIME
+5 if '$TEST
SET X="^"
+6 if X["^"
SET STOPIT=2
+7 USE IO
+8 QUIT
+9 ;
PAUSE2 ;If sending report to screen display pause message at screen bottom;
+1 NEW X
+2 USE IO(0)
+3 WRITE !!,"Press RETURN to continue:"
+4 READ X:DTIME
+5 if '$TEST
SET X="^"
+6 if X["^"
SET STOPIT=2
+7 USE IO
+8 QUIT
+9 ;
ULINE(X,WIDTH) ;Display line of a given character
+1 ;INPUT:
+2 ; X - Character to display
+3 ; WIDTH - Number of Character to display
+4 ;
+5 NEW I
+6 if $GET(WIDTH)'>0
SET WIDTH=80
+7 WRITE !
+8 FOR I=1:1:WIDTH
WRITE $GET(X,"-")
+9 QUIT
+10 ;
