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

IBUCMM.m

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