IBUCMM ;WOIFO/AAT-IBUC VISIT SUMMARY/DETAIL REPORT;30-JUL-02
;;2.0;INTEGRATED BILLING;**663,671**;21-MAR-94;Build 13
;; Per VHA Directive 6402, this routine should not be modified
;
N IBQUIT,IBSD,IBCA,IBEXCEL
N IBBDT,IBEDT,%DT,X,Y,DIC
F S IBQUIT=0 D Q:IBQUIT
. W !
. D DATE I IBBDT<0 S IBQUIT=1 Q
. ;
. W !! ;Add a couple of lines of spacer before the next set of prompts
. ; Ask the user if they want a detailed or summary version of the report
. S IBSD=$$GETPRMPT("SD") I IBSD=-1 S IBQUIT=1 Q
. ;
. ; Ask the user if they want to report on visits at their site only or all sites
. S IBCA=$$GETPRMPT("CA") I IBCA=-1 S IBQUIT=1 Q
. ;
. S IBEXCEL=$$GETEXCEL I IBEXCEL=-1 S IBQUIT=1 Q
. I IBEXCEL D PRTEXCEL
. D ASKDEV ;Choose device and run/schedule printing
. S IBQUIT=1 ;Probably the report will not be printed repeatedly
Q
;
ASKDEV ; Ask about output device and print the report (or run task)
N %ZIS,POP
W:'IBEXCEL !!,"Report requires 132 columns.",!
S %ZIS="QM"
W ! D ^%ZIS Q:POP ; Quit and ask for patient again. Otherwise Set IBSTOP=1
; If it was queued
I $D(IO("Q")) D RUNTASK Q
U IO D REPORT^IBUCMM1 ; Generate report directly
D ^%ZISC ; Close the device
Q
;
;
RUNTASK ; Start Taskman job
N ZTRTN,ZTSK,IBVAR,ZTSAVE,ZTDESC
S ZTRTN="REPORT^IBUCMM1",ZTDESC="IB Urgent Care Visit Summary/Detail Report"
F IBVAR="IBBDT","IBEDT","IBSD","IBCA","IBEXCEL" S ZTSAVE(IBVAR)=""
D ^%ZTLOAD
I $G(ZTSK) W !!,"This request has been queued. The task number is "_ZTSK_"."
E W !!,"Unable to queue this job."
K IO("Q")
D HOME^%ZIS W !
Q
;
; Ask begin/end dates, with default values
; Input: none
; Output: IBBDT,IBEDT - begin/end dates
DATE N %DT,Y,IBNOW
S IBNOW=$$NOW()
DATAGN ;Loop entry point
S (IBBDT,IBEDT)=-1
; Get beginning date
S IBBDT=$$ASKDT("Start with DATE: ",$$FIRST(IBNOW))
I IBBDT<1 Q
; Get ending date
S IBEDT=$$ASKDT("Go to DATE: ",$$LAST(IBNOW))
I IBEDT<1 S IBBDT=-1 Q ;User cancelled
I IBEDT<IBBDT W !,"Ending date must follow start date!",! G DATAGN
Q
;
;Define the first day of the given month
FIRST(IBDT) S $E(IBDT,6,7)="01"
Q IBDT
;
;Define the last day of the given month
LAST(IBDT) N IBM,IBY,X1,X2,X
S IBY=$E(IBDT,1,3),IBM=+$E(IBDT,4,5)
S IBM=IBM+1 I IBM>12 S IBM=1,IBY=IBY+1
I $L(IBM)<2 S IBM="0"_IBM
S X1=IBY_IBM_"01",X2=-1
D C^%DTC
Q X
;
;Returns today's date in FM format
NOW() N %,%H,%I,X
D NOW^%DTC
Q X
;
; Input: prompt, default value (FM format)
; Output: date (FM) or -1, if cancelled
ASKDT(IBPRMT,IBDFLT) ;Date input
N DIR,Y,Y0,X,DIROUT,DIRUT
I $G(IBPRMT)'="" S DIR("A")=IBPRMT
I $G(IBDFLT)'="" S DIR("B")=$$FMTE^XLFDT(IBDFLT,"1D")
S DIR(0)="DA"
D ^DIR I $D(DIRUT) Q -1
W " (",$$FMTE^XLFDT(Y),")"
Q Y
;
;Ask the user some questions about what to report
GETPRMPT(IBPRMPT) ;
;
;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
;
; Prompt Summary or Detail version
I $G(IBPRMPT)="SD" D
. S DIR("A")="(S)ummary or (D)etailed Report: "
. S DIR("B")="S"
. S DIR(0)="SA^S:SUMMARY;D:DETAILED"
. S DIR("?")="Select the type of report to Generate."
;
; Prompt Current or All Sites
I $G(IBPRMPT)="CA" D
. S DIR("A")="(C)urrent or (A)ll Sites: "
. S DIR(0)="SA^C:CURRENT;A:ALL SITES"
. S DIR("B")="A"
. S DIR("?")="Select C to run for your site only, otherwise, select A to report on all sites with Urgent Care visits Tracked at this site."
;
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!($G(Y)="") Q -1
Q Y
;
;
GETEXCEL() ; Export the report to MS Excel?
; Function return values:
; 0 - User selected "No" at prompt.
; 1 - User selected "Yes" at prompt.
; ^ - User aborted.
; This function allows the user to indicate whether the report should be
; printed in a format that could easily be imported into an Excel
; spreadsheet. If the user wants to print in EXCEL format, the variable
; IBEXCEL will be set to '1', otherwise IBEXCEL will be set to '0' for "No"
; or "^" to abort.
;
N DIR,DIRUT,Y
S DIR(0)="Y"
S DIR("A")="Export the report to Microsoft Excel (Y/N)"
I $G(IBEXCEL)=1 S DIR("B")="YES"
E S DIR("B")="NO"
S DIR("?",1)="If you want to capture the output from this report in a format that"
S DIR("?",2)="could easily be imported into an Excel spreadsheet, then answer YES here."
S DIR("?")="If you want a normal report output, then answer NO here."
W !
D ^DIR
K DIR
I $D(DIRUT) Q -1 ; Abort
Q +Y
;
PRTEXCEL() ;Print the MS Excel instructions.
W !!?5,"Before continuing, please set up your terminal to capture the"
W !?5,"detail report data and save the detail report data in a text file"
W !?5,"to a local drive. This report may take a while to run."
W !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
W !?11,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBUCMM 4968 printed Dec 13, 2024@02:29:18 Page 2
IBUCMM ;WOIFO/AAT-IBUC VISIT SUMMARY/DETAIL REPORT;30-JUL-02
+1 ;;2.0;INTEGRATED BILLING;**663,671**;21-MAR-94;Build 13
+2 ;; Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 NEW IBQUIT,IBSD,IBCA,IBEXCEL
+5 NEW IBBDT,IBEDT,%DT,X,Y,DIC
+6 FOR
SET IBQUIT=0
Begin DoDot:1
+7 WRITE !
+8 DO DATE
IF IBBDT<0
SET IBQUIT=1
QUIT
+9 ;
+10 ;Add a couple of lines of spacer before the next set of prompts
WRITE !!
+11 ; Ask the user if they want a detailed or summary version of the report
+12 SET IBSD=$$GETPRMPT("SD")
IF IBSD=-1
SET IBQUIT=1
QUIT
+13 ;
+14 ; Ask the user if they want to report on visits at their site only or all sites
+15 SET IBCA=$$GETPRMPT("CA")
IF IBCA=-1
SET IBQUIT=1
QUIT
+16 ;
+17 SET IBEXCEL=$$GETEXCEL
IF IBEXCEL=-1
SET IBQUIT=1
QUIT
+18 IF IBEXCEL
DO PRTEXCEL
+19 ;Choose device and run/schedule printing
DO ASKDEV
+20 ;Probably the report will not be printed repeatedly
SET IBQUIT=1
End DoDot:1
if IBQUIT
QUIT
+21 QUIT
+22 ;
ASKDEV ; Ask about output device and print the report (or run task)
+1 NEW %ZIS,POP
+2 if 'IBEXCEL
WRITE !!,"Report requires 132 columns.",!
+3 SET %ZIS="QM"
+4 ; Quit and ask for patient again. Otherwise Set IBSTOP=1
WRITE !
DO ^%ZIS
if POP
QUIT
+5 ; If it was queued
+6 IF $DATA(IO("Q"))
DO RUNTASK
QUIT
+7 ; Generate report directly
USE IO
DO REPORT^IBUCMM1
+8 ; Close the device
DO ^%ZISC
+9 QUIT
+10 ;
+11 ;
RUNTASK ; Start Taskman job
+1 NEW ZTRTN,ZTSK,IBVAR,ZTSAVE,ZTDESC
+2 SET ZTRTN="REPORT^IBUCMM1"
SET ZTDESC="IB Urgent Care Visit Summary/Detail Report"
+3 FOR IBVAR="IBBDT","IBEDT","IBSD","IBCA","IBEXCEL"
SET ZTSAVE(IBVAR)=""
+4 DO ^%ZTLOAD
+5 IF $GET(ZTSK)
WRITE !!,"This request has been queued. The task number is "_ZTSK_"."
+6 IF '$TEST
WRITE !!,"Unable to queue this job."
+7 KILL IO("Q")
+8 DO HOME^%ZIS
WRITE !
+9 QUIT
+10 ;
+11 ; Ask begin/end dates, with default values
+12 ; Input: none
+13 ; Output: IBBDT,IBEDT - begin/end dates
DATE NEW %DT,Y,IBNOW
+1 SET IBNOW=$$NOW()
DATAGN ;Loop entry point
+1 SET (IBBDT,IBEDT)=-1
+2 ; Get beginning date
+3 SET IBBDT=$$ASKDT("Start with DATE: ",$$FIRST(IBNOW))
+4 IF IBBDT<1
QUIT
+5 ; Get ending date
+6 SET IBEDT=$$ASKDT("Go to DATE: ",$$LAST(IBNOW))
+7 ;User cancelled
IF IBEDT<1
SET IBBDT=-1
QUIT
+8 IF IBEDT<IBBDT
WRITE !,"Ending date must follow start date!",!
GOTO DATAGN
+9 QUIT
+10 ;
+11 ;Define the first day of the given month
FIRST(IBDT) SET $EXTRACT(IBDT,6,7)="01"
+1 QUIT IBDT
+2 ;
+3 ;Define the last day of the given month
LAST(IBDT) NEW IBM,IBY,X1,X2,X
+1 SET IBY=$EXTRACT(IBDT,1,3)
SET IBM=+$EXTRACT(IBDT,4,5)
+2 SET IBM=IBM+1
IF IBM>12
SET IBM=1
SET IBY=IBY+1
+3 IF $LENGTH(IBM)<2
SET IBM="0"_IBM
+4 SET X1=IBY_IBM_"01"
SET X2=-1
+5 DO C^%DTC
+6 QUIT X
+7 ;
+8 ;Returns today's date in FM format
NOW() NEW %,%H,%I,X
+1 DO NOW^%DTC
+2 QUIT X
+3 ;
+4 ; Input: prompt, default value (FM format)
+5 ; Output: date (FM) or -1, if cancelled
ASKDT(IBPRMT,IBDFLT) ;Date input
+1 NEW DIR,Y,Y0,X,DIROUT,DIRUT
+2 IF $GET(IBPRMT)'=""
SET DIR("A")=IBPRMT
+3 IF $GET(IBDFLT)'=""
SET DIR("B")=$$FMTE^XLFDT(IBDFLT,"1D")
+4 SET DIR(0)="DA"
+5 DO ^DIR
IF $DATA(DIRUT)
QUIT -1
+6 WRITE " (",$$FMTE^XLFDT(Y),")"
+7 QUIT Y
+8 ;
+9 ;Ask the user some questions about what to report
GETPRMPT(IBPRMPT) ;
+1 ;
+2 ;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
+3 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
+4 ;
+5 ; Prompt Summary or Detail version
+6 IF $GET(IBPRMPT)="SD"
Begin DoDot:1
+7 SET DIR("A")="(S)ummary or (D)etailed Report: "
+8 SET DIR("B")="S"
+9 SET DIR(0)="SA^S:SUMMARY;D:DETAILED"
+10 SET DIR("?")="Select the type of report to Generate."
End DoDot:1
+11 ;
+12 ; Prompt Current or All Sites
+13 IF $GET(IBPRMPT)="CA"
Begin DoDot:1
+14 SET DIR("A")="(C)urrent or (A)ll Sites: "
+15 SET DIR(0)="SA^C:CURRENT;A:ALL SITES"
+16 SET DIR("B")="A"
+17 SET DIR("?")="Select C to run for your site only, otherwise, select A to report on all sites with Urgent Care visits Tracked at this site."
End DoDot:1
+18 ;
+19 DO ^DIR
KILL DIR
+20 IF $DATA(DTOUT)!$DATA(DUOUT)!($GET(Y)="")
QUIT -1
+21 QUIT Y
+22 ;
+23 ;
GETEXCEL() ; Export the report to MS Excel?
+1 ; Function return values:
+2 ; 0 - User selected "No" at prompt.
+3 ; 1 - User selected "Yes" at prompt.
+4 ; ^ - User aborted.
+5 ; This function allows the user to indicate whether the report should be
+6 ; printed in a format that could easily be imported into an Excel
+7 ; spreadsheet. If the user wants to print in EXCEL format, the variable
+8 ; IBEXCEL will be set to '1', otherwise IBEXCEL will be set to '0' for "No"
+9 ; or "^" to abort.
+10 ;
+11 NEW DIR,DIRUT,Y
+12 SET DIR(0)="Y"
+13 SET DIR("A")="Export the report to Microsoft Excel (Y/N)"
+14 IF $GET(IBEXCEL)=1
SET DIR("B")="YES"
+15 IF '$TEST
SET DIR("B")="NO"
+16 SET DIR("?",1)="If you want to capture the output from this report in a format that"
+17 SET DIR("?",2)="could easily be imported into an Excel spreadsheet, then answer YES here."
+18 SET DIR("?")="If you want a normal report output, then answer NO here."
+19 WRITE !
+20 DO ^DIR
+21 KILL DIR
+22 ; Abort
IF $DATA(DIRUT)
QUIT -1
+23 QUIT +Y
+24 ;
PRTEXCEL() ;Print the MS Excel instructions.
+1 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+2 WRITE !?5,"detail report data and save the detail report data in a text file"
+3 WRITE !?5,"to a local drive. This report may take a while to run."
+4 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
+5 WRITE !?11,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
+6 QUIT
