source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAGMM.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1IBAGMM ;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 ;
14ASKDEV ; 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 ;
25RUNTASK ; 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
40DATE N %DT,Y,IBNOW
41 S IBNOW=$$NOW()
42DATAGN ;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
57FIRST(IBDT) S $E(IBDT,6,7)="01"
58 Q IBDT
59 ;
60 ;Define the last day of the given month
61LAST(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
70NOW() 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
76ASKDT(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
Note: See TracBrowser for help on using the repository browser.