Routine: IBAGMM

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

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

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 !

 ; 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."

 ;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  Mar 13, 2025@21:11:07                                                                                                                                                                                                      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

IBAGMM.m