IBAGMR ;WOIFO/AAT-GMT SINGLE PATIENT REPORT;11-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 IBDFN,IBBDT,IBEDT,%DT,X,Y,DIC
. W !
. S IBDFN=$$ASKPAT() I IBDFN=-1 S IBQUIT=1 Q
. D DATE I IBBDT<0 Q ;S IBQUIT=1 Q ;Enter date range (defaults are begin/end of the clock)
. D ASKDEV ;Choose device and run/schedule printing
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^IBAGMR1 ; Generate report directly
D ^%ZISC ; Close the device
Q
;
;
RUNTASK ; Start Taskman job
N ZTRTN,ZTSK,IBVAR,ZTSAVE,ZTDESC
S ZTRTN="REPORT^IBAGMR1",ZTDESC="IB GMT SINGLE PATIENT REPORT"
F IBVAR="IBDFN","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,IBGMTEFD
S IBNOW=$$NOW(),IBGMTEFD=$$GMTEFD^IBAGMT
DATAGN ;Loop entry point
S (IBBDT,IBEDT)=-1
; Get beginning date
S IBBDT=$$ASKDT("Start with DATE: ",$S(IBNOW<IBGMTEFD:IBNOW,1:IBGMTEFD))
I IBBDT<1 Q
; Get ending date
S IBEDT=$$ASKDT("Go to DATE: ",IBNOW)
I IBEDT<1 S IBBDT=-1 Q ;User cancelled
I IBEDT<IBBDT W !,"Ending date must follow start date!",! G DATAGN
Q
;
;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
;
ASKPAT() N Y,DIC,IBGMTST
S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC
I Y>0 S IBGMTST=$$ISGMTPT^IBAGMT(Y,DT)
I Y>0,IBGMTST=-1 W !!,"*** WARNING! GMT Copayment Status is unknown for the patient!",!
I Y>0,IBGMTST=0 W !!,"*** WARNING! The patient does not have GMT Copayment Status!",!
Q +$G(Y,-1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAGMR 2345 printed Apr 09, 2024@21:23:16 Page 2
IBAGMR ;WOIFO/AAT-GMT SINGLE PATIENT REPORT;11-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 IBDFN,IBBDT,IBEDT,%DT,X,Y,DIC
+7 WRITE !
+8 SET IBDFN=$$ASKPAT()
IF IBDFN=-1
SET IBQUIT=1
QUIT
+9 ;S IBQUIT=1 Q ;Enter date range (defaults are begin/end of the clock)
DO DATE
IF IBBDT<0
QUIT
+10 ;Choose device and run/schedule printing
DO ASKDEV
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^IBAGMR1
+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^IBAGMR1"
SET ZTDESC="IB GMT SINGLE PATIENT REPORT"
+3 FOR IBVAR="IBDFN","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,IBGMTEFD
+1 SET IBNOW=$$NOW()
SET IBGMTEFD=$$GMTEFD^IBAGMT
DATAGN ;Loop entry point
+1 SET (IBBDT,IBEDT)=-1
+2 ; Get beginning date
+3 SET IBBDT=$$ASKDT("Start with DATE: ",$SELECT(IBNOW<IBGMTEFD:IBNOW,1:IBGMTEFD))
+4 IF IBBDT<1
QUIT
+5 ; Get ending date
+6 SET IBEDT=$$ASKDT("Go to DATE: ",IBNOW)
+7 ;User cancelled
IF IBEDT<1
SET IBBDT=-1
QUIT
+8 IF IBEDT<IBBDT
WRITE !,"Ending date must follow start date!",!
GOTO DATAGN
+9 QUIT
+10 ;
+11 ;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
+8 ;
ASKPAT() NEW Y,DIC,IBGMTST
+1 SET DIC="^DPT("
SET DIC(0)="AEQMN"
DO ^DIC
+2 IF Y>0
SET IBGMTST=$$ISGMTPT^IBAGMT(Y,DT)
+3 IF Y>0
IF IBGMTST=-1
WRITE !!,"*** WARNING! GMT Copayment Status is unknown for the patient!",!
+4 IF Y>0
IF IBGMTST=0
WRITE !!,"*** WARNING! The patient does not have GMT Copayment Status!",!
+5 QUIT +$GET(Y,-1)
