IBAGMM ;WOIFO/AAT-GMT MONTHLY TOTALS REPORT;30-JUL-02
;;2.0;INTEGRATED BILLING;**183**;21-MAR-94
;; Per VHA Directive 10-93-142, this routine should not be modified
;
N IBQUIT
F S IBQUIT=0 D Q:IBQUIT
. N IBBDT,IBEDT,%DT,X,Y,DIC
. W !
. D DATE I IBBDT<0 S IBQUIT=1 Q
. 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
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^IBAGMM1 ; Generate report directly
D ^%ZISC ; Close the device
Q
;
;
RUNTASK ; Start Taskman job
N ZTRTN,ZTSK,IBVAR,ZTSAVE,ZTDESC
S ZTRTN="REPORT^IBAGMM1",ZTDESC="IB GMT MONTHLY TOTALS REPORT"
F IBVAR="IBBDT","IBEDT" 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
I IBBDT'=$$FIRST(IBBDT) W !!,"Warning! The Start date is not the first day of the month.",!
; 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
I IBBDT<$$GMTEFD^IBAGMT() W !!,"Warning! The Start date is earlier than the GMT Effective Date - ",$$DAT^IBAGMM1($$GMTEFD^IBAGMT)
I IBEDT'=$$LAST(IBEDT) W !!,"Warning! The Ending date is not the last day of the month."
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAGMM 2582 printed Nov 22, 2024@17:16:23 Page 2
IBAGMM ;WOIFO/AAT-GMT MONTHLY TOTALS REPORT;30-JUL-02
+1 ;;2.0;INTEGRATED BILLING;**183**;21-MAR-94
+2 ;; Per VHA Directive 10-93-142, this routine should not be modified
+3 ;
+4 NEW IBQUIT
+5 FOR
SET IBQUIT=0
Begin DoDot:1
+6 NEW IBBDT,IBEDT,%DT,X,Y,DIC
+7 WRITE !
+8 DO DATE
IF IBBDT<0
SET IBQUIT=1
QUIT
+9 ;Choose device and run/schedule printing
DO ASKDEV
+10 ;Probably the report will not be printed repeatedly
SET IBQUIT=1
End DoDot:1
if IBQUIT
QUIT
+11 QUIT
+12 ;
ASKDEV ; Ask about output device and print the report (or run task)
+1 NEW %ZIS,POP
+2 SET %ZIS="QM"
+3 ; Quit and ask for patient again. Otherwise Set IBSTOP=1
WRITE !
DO ^%ZIS
if POP
QUIT
+4 ; If it was queued
+5 IF $DATA(IO("Q"))
DO RUNTASK
QUIT
+6 ; Generate report directly
USE IO
DO REPORT^IBAGMM1
+7 ; Close the device
DO ^%ZISC
+8 QUIT
+9 ;
+10 ;
RUNTASK ; Start Taskman job
+1 NEW ZTRTN,ZTSK,IBVAR,ZTSAVE,ZTDESC
+2 SET ZTRTN="REPORT^IBAGMM1"
SET ZTDESC="IB GMT MONTHLY TOTALS REPORT"
+3 FOR IBVAR="IBBDT","IBEDT"
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 ;
+12 ; Ask begin/end dates, with default values
+13 ; Input: none
+14 ; 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 IF IBBDT'=$$FIRST(IBBDT)
WRITE !!,"Warning! The Start date is not the first day of the month.",!
+6 ; Get ending date
+7 SET IBEDT=$$ASKDT("Go to DATE: ",$$LAST(IBNOW))
+8 ;User cancelled
IF IBEDT<1
SET IBBDT=-1
QUIT
+9 IF IBEDT<IBBDT
WRITE !,"Ending date must follow start date!",!
GOTO DATAGN
+10 IF IBBDT<$$GMTEFD^IBAGMT()
WRITE !!,"Warning! The Start date is earlier than the GMT Effective Date - ",$$DAT^IBAGMM1($$GMTEFD^IBAGMT)
+11 IF IBEDT'=$$LAST(IBEDT)
WRITE !!,"Warning! The Ending date is not the last day of the month."
+12 QUIT
+13 ;
+14 ;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
