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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1IBAGMR ;WOIFO/AAT-GMT SINGLE PATIENT REPORT;11-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 IBDFN,IBBDT,IBEDT,%DT,X,Y,DIC
8 . W !
9 . S IBDFN=$$ASKPAT() I IBDFN=-1 S IBQUIT=1 Q
10 . D DATE I IBBDT<0 Q ;S IBQUIT=1 Q ;Enter date range (defaults are begin/end of the clock)
11 . D ASKDEV ;Choose device and run/schedule printing
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^IBAGMR1 ; 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^IBAGMR1",ZTDESC="IB GMT SINGLE PATIENT REPORT"
28 F IBVAR="IBDFN","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,IBGMTEFD
41 S IBNOW=$$NOW(),IBGMTEFD=$$GMTEFD^IBAGMT
42DATAGN ;Loop entry point
43 S (IBBDT,IBEDT)=-1
44 ; Get beginning date
45 S IBBDT=$$ASKDT("Start with DATE: ",$S(IBNOW<IBGMTEFD:IBNOW,1:IBGMTEFD))
46 I IBBDT<1 Q
47 ; Get ending date
48 S IBEDT=$$ASKDT("Go to DATE: ",IBNOW)
49 I IBEDT<1 S IBBDT=-1 Q ;User cancelled
50 I IBEDT<IBBDT W !,"Ending date must follow start date!",! G DATAGN
51 Q
52 ;
53 ;Returns today's date in FM format
54NOW() N %,%H,%I,X
55 D NOW^%DTC
56 Q X
57 ;
58 ; Input: prompt, default value (FM format)
59 ; Output: date (FM) or -1, if cancelled
60ASKDT(IBPRMT,IBDFLT) ;Date input
61 N DIR,Y,Y0,X,DIROUT,DIRUT
62 I $G(IBPRMT)'="" S DIR("A")=IBPRMT
63 I $G(IBDFLT)'="" S DIR("B")=$$FMTE^XLFDT(IBDFLT,"1D")
64 S DIR(0)="DA"
65 D ^DIR I $D(DIRUT) Q -1
66 W " (",$$FMTE^XLFDT(Y),")"
67 Q Y
68 ;
69ASKPAT() N Y,DIC,IBGMTST
70 S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC
71 I Y>0 S IBGMTST=$$ISGMTPT^IBAGMT(Y,DT)
72 I Y>0,IBGMTST=-1 W !!,"*** WARNING! GMT Copayment Status is unknown for the patient!",!
73 I Y>0,IBGMTST=0 W !!,"*** WARNING! The patient does not have GMT Copayment Status!",!
74 Q +$G(Y,-1)
Note: See TracBrowser for help on using the repository browser.