| 1 | IBAGMM ;WOIFO/AAT-GMT MONTHLY TOTALS REPORT;30-JUL-02
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**183**;21-MAR-94
|
|---|
| 3 | ;; Per VHA Directive 10-93-142, this routine should not be modified
|
|---|
| 4 | ;
|
|---|
| 5 | N IBQUIT
|
|---|
| 6 | F S IBQUIT=0 D Q:IBQUIT
|
|---|
| 7 | . N IBBDT,IBEDT,%DT,X,Y,DIC
|
|---|
| 8 | . W !
|
|---|
| 9 | . D DATE I IBBDT<0 S IBQUIT=1 Q
|
|---|
| 10 | . D ASKDEV ;Choose device and run/schedule printing
|
|---|
| 11 | . S IBQUIT=1 ;Probably the report will not be printed repeatedly
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | ASKDEV ; Ask about output device and print the report (or run task)
|
|---|
| 15 | N %ZIS,POP
|
|---|
| 16 | S %ZIS="QM"
|
|---|
| 17 | W ! D ^%ZIS Q:POP ; Quit and ask for patient again. Otherwise Set IBSTOP=1
|
|---|
| 18 | ; If it was queued
|
|---|
| 19 | I $D(IO("Q")) D RUNTASK Q
|
|---|
| 20 | U IO D REPORT^IBAGMM1 ; Generate report directly
|
|---|
| 21 | D ^%ZISC ; Close the device
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | ;
|
|---|
| 25 | RUNTASK ; Start Taskman job
|
|---|
| 26 | N ZTRTN,ZTSK,IBVAR,ZTSAVE,ZTDESC
|
|---|
| 27 | S ZTRTN="REPORT^IBAGMM1",ZTDESC="IB GMT MONTHLY TOTALS REPORT"
|
|---|
| 28 | F IBVAR="IBBDT","IBEDT" S ZTSAVE(IBVAR)=""
|
|---|
| 29 | D ^%ZTLOAD
|
|---|
| 30 | I $G(ZTSK) W !!,"This request has been queued. The task number is "_ZTSK_"."
|
|---|
| 31 | E W !!,"Unable to queue this job."
|
|---|
| 32 | K IO("Q")
|
|---|
| 33 | D HOME^%ZIS W !
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | ;
|
|---|
| 37 | ; Ask begin/end dates, with default values
|
|---|
| 38 | ; Input: none
|
|---|
| 39 | ; Output: IBBDT,IBEDT - begin/end dates
|
|---|
| 40 | DATE N %DT,Y,IBNOW
|
|---|
| 41 | S IBNOW=$$NOW()
|
|---|
| 42 | DATAGN ;Loop entry point
|
|---|
| 43 | S (IBBDT,IBEDT)=-1
|
|---|
| 44 | ; Get beginning date
|
|---|
| 45 | S IBBDT=$$ASKDT("Start with DATE: ",$$FIRST(IBNOW))
|
|---|
| 46 | I IBBDT<1 Q
|
|---|
| 47 | I IBBDT'=$$FIRST(IBBDT) W !!,"Warning! The Start date is not the first day of the month.",!
|
|---|
| 48 | ; Get ending date
|
|---|
| 49 | S IBEDT=$$ASKDT("Go to DATE: ",$$LAST(IBNOW))
|
|---|
| 50 | I IBEDT<1 S IBBDT=-1 Q ;User cancelled
|
|---|
| 51 | I IBEDT<IBBDT W !,"Ending date must follow start date!",! G DATAGN
|
|---|
| 52 | I IBBDT<$$GMTEFD^IBAGMT() W !!,"Warning! The Start date is earlier than the GMT Effective Date - ",$$DAT^IBAGMM1($$GMTEFD^IBAGMT)
|
|---|
| 53 | I IBEDT'=$$LAST(IBEDT) W !!,"Warning! The Ending date is not the last day of the month."
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | ;Define the first day of the given month
|
|---|
| 57 | FIRST(IBDT) S $E(IBDT,6,7)="01"
|
|---|
| 58 | Q IBDT
|
|---|
| 59 | ;
|
|---|
| 60 | ;Define the last day of the given month
|
|---|
| 61 | LAST(IBDT) N IBM,IBY,X1,X2,X
|
|---|
| 62 | S IBY=$E(IBDT,1,3),IBM=+$E(IBDT,4,5)
|
|---|
| 63 | S IBM=IBM+1 I IBM>12 S IBM=1,IBY=IBY+1
|
|---|
| 64 | I $L(IBM)<2 S IBM="0"_IBM
|
|---|
| 65 | S X1=IBY_IBM_"01",X2=-1
|
|---|
| 66 | D C^%DTC
|
|---|
| 67 | Q X
|
|---|
| 68 | ;
|
|---|
| 69 | ;Returns today's date in FM format
|
|---|
| 70 | NOW() N %,%H,%I,X
|
|---|
| 71 | D NOW^%DTC
|
|---|
| 72 | Q X
|
|---|
| 73 | ;
|
|---|
| 74 | ; Input: prompt, default value (FM format)
|
|---|
| 75 | ; Output: date (FM) or -1, if cancelled
|
|---|
| 76 | ASKDT(IBPRMT,IBDFLT) ;Date input
|
|---|
| 77 | N DIR,Y,Y0,X,DIROUT,DIRUT
|
|---|
| 78 | I $G(IBPRMT)'="" S DIR("A")=IBPRMT
|
|---|
| 79 | I $G(IBDFLT)'="" S DIR("B")=$$FMTE^XLFDT(IBDFLT,"1D")
|
|---|
| 80 | S DIR(0)="DA"
|
|---|
| 81 | D ^DIR I $D(DIRUT) Q -1
|
|---|
| 82 | W " (",$$FMTE^XLFDT(Y),")"
|
|---|
| 83 | Q Y
|
|---|
