- IBTOUA ;ALB/AAS - CLAIMS TRACKING UNSCHEDULED ADMISSION REPORT ; 27-OCT-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- % I '$D(DT) D DT^DICRW
- W !!,"Unscheduled Admissions Report"
- ;
- DATE ; -- select date
- W !! D DATE^IBOUTL
- I IBBDT=""!(IBEDT="") G END
- ;
- DEV ; -- select device, run option
- W !!,"You will need a 132 column printer for this report!",!
- S %ZIS="QM" D ^%ZIS G:POP END
- I $D(IO("Q")) S ZTRTN="DQ^IBTOUA",ZTSAVE("IB*")="",ZTDESC="IB - Unscheduled Admissions Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
- ;
- U IO
- S X=132 X ^%ZOSF("RM")
- DQ D PRINT G END
- Q
- ;
- END ; -- Clean up
- K ^TMP($J) W !
- I $D(ZTQUEUED) S ZTREQ="@" Q
- D ^%ZISC
- K I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT
- Q
- ;
- PRINT ; -- print one billing report from ct
- S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
- K ^TMP($J)
- ;
- D FIX^IBTOSA
- S IBDT=IBBDT-.1
- F S IBDT=$O(^IBT(356,"D",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24))!(IBQUIT) S IBTRN=0 F S IBTRN=$O(^IBT(356,"D",IBDT,IBTRN)) Q:'IBTRN!(IBQUIT) S IBTRND=$G(^IBT(356,IBTRN,0)) D
- .Q:'$P(IBTRND,"^",20) ; inactive
- .Q:+IBDT<IBEDT
- .I $P(IBTRND,"^",5),$P(IBTRND,"^",7)'=1,$$INSURED^IBCNS1($P(IBTRND,"^",2),IBDT) D SET
- ;
- PR D HDR
- I '$D(^TMP($J,"IBSCH")) W !!,"No Unscheduled Admission found in date range.",! Q
- S IBNAM="",IBCNT=0
- F S IBNAM=$O(^TMP($J,"IBSCH",IBNAM)) Q:IBNAM=""!(IBQUIT) S IBDT=0 F S IBDT=$O(^TMP($J,"IBSCH",IBNAM,IBDT)) Q:'IBDT!(IBQUIT) S IBTRN=0 F S IBTRN=$O(^TMP($J,"IBSCH",IBNAM,IBDT,IBTRN)) Q:'IBTRN!(IBQUIT) S IBTRND=^(IBTRN) D ONE
- ;
- Q:IBQUIT
- W !!,"------------------"
- W !,"TOTAL = ",IBCNT
- I $D(ZTQUEUED) G END
- Q
- ;
- ONE ; -- Print one patients data
- Q:IBQUIT
- I IOSL<($Y+5) D HDR Q:IBQUIT
- S IBCNT=IBCNT+1
- S DFN=$P(IBTRND,"^",2) D PID^VADPT
- W !,$E(IBNAM,1,27),?30,VA("PID"),?45,$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
- W ?66,$S('$P(IBTRND,"^",19):"YES",1:$E("NO - "_$P($G(^IBE(356.8,+$P(IBTRND,"^",19),0)),"^"),1,27))
- W ?100,$E($P($G(^DPT(DFN,.1)),"^"),1,12),?115,$E($$EXPAND^IBTRE(356,.07,$P(IBTRND,"^",7)),1,15)
- Q
- ;
- HDR ; -- Print header for billing report
- Q:IBQUIT
- I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
- I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
- S IBPAG=IBPAG+1
- W !,"Unscheduled Admissions with Insurance",?(IOM-33),"Page ",IBPAG," ",IBHDT
- W !,"For Period beginning on ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
- W !,"Patient",?30,"Pt. ID",?45,"Adm. Date",?66,"Billable",?100,"Ward",?115,"Type"
- W !,$TR($J(" ",IOM)," ","-")
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 W !!,"....task stoped at user request"
- Q
- ;
- SET ; -- set tmp array
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 D HDR W !!,"....task stoped at user request" Q
- S ^TMP($J,"IBSCH",$P(^DPT(+$P(IBTRND,"^",2),0),"^"),IBDT,IBTRN)=IBTRND
- Q
- IBTOUA ;ALB/AAS - CLAIMS TRACKING UNSCHEDULED ADMISSION REPORT ; 27-OCT-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- % IF '$DATA(DT)
- DO DT^DICRW
- +1 WRITE !!,"Unscheduled Admissions Report"
- +2 ;
- DATE ; -- select date
- +1 WRITE !!
- DO DATE^IBOUTL
- +2 IF IBBDT=""!(IBEDT="")
- GOTO END
- +3 ;
- DEV ; -- select device, run option
- +1 WRITE !!,"You will need a 132 column printer for this report!",!
- +2 SET %ZIS="QM"
- DO ^%ZIS
- IF POP
- GOTO END
- +3 IF $DATA(IO("Q"))
- SET ZTRTN="DQ^IBTOUA"
- SET ZTSAVE("IB*")=""
- SET ZTDESC="IB - Unscheduled Admissions Report"
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- DO HOME^%ZIS
- GOTO END
- +4 ;
- +5 USE IO
- +6 SET X=132
- XECUTE ^%ZOSF("RM")
- DQ DO PRINT
- GOTO END
- +1 QUIT
- +2 ;
- END ; -- Clean up
- +1 KILL ^TMP($JOB)
- WRITE !
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +3 DO ^%ZISC
- +4 KILL I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT
- +5 QUIT
- +6 ;
- PRINT ; -- print one billing report from ct
- +1 SET IBPAG=0
- SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
- SET IBQUIT=0
- +2 KILL ^TMP($JOB)
- +3 ;
- +4 DO FIX^IBTOSA
- +5 SET IBDT=IBBDT-.1
- +6 FOR
- SET IBDT=$ORDER(^IBT(356,"D",IBDT))
- IF 'IBDT!(IBDT>(IBEDT+.24))!(IBQUIT)
- QUIT
- SET IBTRN=0
- FOR
- SET IBTRN=$ORDER(^IBT(356,"D",IBDT,IBTRN))
- IF 'IBTRN!(IBQUIT)
- QUIT
- SET IBTRND=$GET(^IBT(356,IBTRN,0))
- Begin DoDot:1
- +7 ; inactive
- IF '$PIECE(IBTRND,"^",20)
- QUIT
- +8 IF +IBDT<IBEDT
- QUIT
- +9 IF $PIECE(IBTRND,"^",5)
- IF $PIECE(IBTRND,"^",7)'=1
- IF $$INSURED^IBCNS1($PIECE(IBTRND,"^",2),IBDT)
- DO SET
- End DoDot:1
- +10 ;
- PR DO HDR
- +1 IF '$DATA(^TMP($JOB,"IBSCH"))
- WRITE !!,"No Unscheduled Admission found in date range.",!
- QUIT
- +2 SET IBNAM=""
- SET IBCNT=0
- +3 FOR
- SET IBNAM=$ORDER(^TMP($JOB,"IBSCH",IBNAM))
- IF IBNAM=""!(IBQUIT)
- QUIT
- SET IBDT=0
- FOR
- SET IBDT=$ORDER(^TMP($JOB,"IBSCH",IBNAM,IBDT))
- IF 'IBDT!(IBQUIT)
- QUIT
- SET IBTRN=0
- FOR
- SET IBTRN=$ORDER(^TMP($JOB,"IBSCH",IBNAM,IBDT,IBTRN))
- IF 'IBTRN!(IBQUIT)
- QUIT
- SET IBTRND=^(IBTRN)
- DO ONE
- +4 ;
- +5 IF IBQUIT
- QUIT
- +6 WRITE !!,"------------------"
- +7 WRITE !,"TOTAL = ",IBCNT
- +8 IF $DATA(ZTQUEUED)
- GOTO END
- +9 QUIT
- +10 ;
- ONE ; -- Print one patients data
- +1 IF IBQUIT
- QUIT
- +2 IF IOSL<($Y+5)
- DO HDR
- IF IBQUIT
- QUIT
- +3 SET IBCNT=IBCNT+1
- +4 SET DFN=$PIECE(IBTRND,"^",2)
- DO PID^VADPT
- +5 WRITE !,$EXTRACT(IBNAM,1,27),?30,VA("PID"),?45,$$DAT1^IBOUTL($PIECE(IBTRND,"^",6),"2P")
- +6 WRITE ?66,$SELECT('$PIECE(IBTRND,"^",19):"YES",1:$EXTRACT("NO - "_$PIECE($GET(^IBE(356.8,+$PIECE(IBTRND,"^",19),0)),"^"),1,27))
- +7 WRITE ?100,$EXTRACT($PIECE($GET(^DPT(DFN,.1)),"^"),1,12),?115,$EXTRACT($$EXPAND^IBTRE(356,.07,$PIECE(IBTRND,"^",7)),1,15)
- +8 QUIT
- +9 ;
- HDR ; -- Print header for billing report
- +1 IF IBQUIT
- QUIT
- +2 IF $EXTRACT(IOST,1,2)="C-"
- IF IBPAG
- DO PAUSE^VALM1
- IF $DATA(DIRUT)
- SET IBQUIT=1
- QUIT
- +3 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
- WRITE @IOF
- +4 SET IBPAG=IBPAG+1
- +5 WRITE !,"Unscheduled Admissions with Insurance",?(IOM-33),"Page ",IBPAG," ",IBHDT
- +6 WRITE !,"For Period beginning on ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
- +7 WRITE !,"Patient",?30,"Pt. ID",?45,"Adm. Date",?66,"Billable",?100,"Ward",?115,"Type"
- +8 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
- +9 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- SET IBQUIT=1
- WRITE !!,"....task stoped at user request"
- +10 QUIT
- +11 ;
- SET ; -- set tmp array
- +1 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- SET IBQUIT=1
- DO HDR
- WRITE !!,"....task stoped at user request"
- QUIT
- +2 SET ^TMP($JOB,"IBSCH",$PIECE(^DPT(+$PIECE(IBTRND,"^",2),0),"^"),IBDT,IBTRN)=IBTRND
- +3 QUIT
