IBAMTI2 ;ALB/CPM - LIST SPECIAL INPATIENT BILLING CASES ; 11-AUG-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
LIST ; List all inpatient billing cases.
;
I '$O(^IBE(351.2,0)) W !!,"There are no special inpatient billing cases on file!" G LISTQ
;
W !!,"This report will print out all special inpatient billing cases.",!
;
S %ZIS="QM" D ^%ZIS G:POP LISTQ
I $D(IO("Q")) D G LISTQ
.S ZTRTN="DQ^IBAMTI2",ZTDESC="LIST ALL SPECIAL INPATIENT BILLING CASES"
.D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
.K ZTSK,IO("Q") D HOME^%ZIS
;
U IO
;
DQ ; Tasked entry point.
;
S (IBPAG,IBQ)=0 D HDR
S IBC=0 F S IBC=$O(^IBE(351.2,IBC)) Q:'IBC D Q:IBQ
.I $Y>(IOSL-12) D PAUSE^IBEMTF2 Q:IBQ D HDR
.D DSPL^IBAMTI1(IBC) W !
;
; - end-of-report pause
D:'IBQ PAUSE^IBEMTF2
;
LISTQ I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K IBC,IBQ,IBPAG
Q
;
HDR ; Generate a report header.
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !?20,"LIST ALL SPECIAL INPATIENT BILLING CASES"
W !?64,"Page: ",IBPAG,!?60,"Run Date: ",$$DAT1^IBOUTL(DT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTI2 1232 printed Dec 13, 2024@02:06:39 Page 2
IBAMTI2 ;ALB/CPM - LIST SPECIAL INPATIENT BILLING CASES ; 11-AUG-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
LIST ; List all inpatient billing cases.
+1 ;
+2 IF '$ORDER(^IBE(351.2,0))
WRITE !!,"There are no special inpatient billing cases on file!"
GOTO LISTQ
+3 ;
+4 WRITE !!,"This report will print out all special inpatient billing cases.",!
+5 ;
+6 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO LISTQ
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN="DQ^IBAMTI2"
SET ZTDESC="LIST ALL SPECIAL INPATIENT BILLING CASES"
+9 DO ^%ZTLOAD
WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+10 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO LISTQ
+11 ;
+12 USE IO
+13 ;
DQ ; Tasked entry point.
+1 ;
+2 SET (IBPAG,IBQ)=0
DO HDR
+3 SET IBC=0
FOR
SET IBC=$ORDER(^IBE(351.2,IBC))
if 'IBC
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-12)
DO PAUSE^IBEMTF2
if IBQ
QUIT
DO HDR
+5 DO DSPL^IBAMTI1(IBC)
WRITE !
End DoDot:1
if IBQ
QUIT
+6 ;
+7 ; - end-of-report pause
+8 if 'IBQ
DO PAUSE^IBEMTF2
+9 ;
LISTQ IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+1 DO ^%ZISC
+2 KILL IBC,IBQ,IBPAG
+3 QUIT
+4 ;
HDR ; Generate a report header.
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+2 SET IBPAG=IBPAG+1
+3 WRITE !?20,"LIST ALL SPECIAL INPATIENT BILLING CASES"
+4 WRITE !?64,"Page: ",IBPAG,!?60,"Run Date: ",$$DAT1^IBOUTL(DT)
+5 QUIT
