- IBOBL ;ALB/ARH - LIST ALL BILLS FOR AN EPISODE OF CARE ; 25-MAY-90
- ;;2.0;INTEGRATED BILLING;**80,106**;21-MAR-94
- ;
- EN ;get parameters then run the report
- D HOME^%ZIS N IBASK,IBCANC,IBX W !!,"Episode of Care Bill List:",!,"--------------------------"
- W !,"Enter a Bill Number to get a list of all bills that match the selected bill's",!,"event date or any of it's outpatient visit dates."
- W !,"Enter a Patient Name and Episode Date to get a list of all bills for a patient",!,"that have either that date as the event date or as an outpatient visit date."
- W !,"This report also includes bills related as continuing episodes of care."
- ;
- S IBASK=$$PB^IBJTU2 Q:IBASK'>0 W !
- I +IBASK=1 S IBX=$$GETDT^IBCRU1("","Episode Date") Q:IBX'?7N S IBASK=IBASK_U_IBX W !
- S IBADDCPT=$$CPT Q:IBADDCPT<0
- S IBCANC=$$CANC Q:IBCANC<0 W !
- ;
- DEV ;get the device
- W !,"Report requires 132 columns."
- S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
- I $D(IO("Q")) S ZTRTN="RPT^IBOBL",ZTDESC="Episode of Care Bill List",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
- U IO
- ;
- RPT ;find, save, and print the data that satisfies the search parameters
- ;entry point for tasked jobs
- ;
- K ^TMP($J,"IBOBL") I '$G(IBASK) G EXIT
- ;
- D FIND
- D PRINT
- ;
- EXIT ;clean up and quit
- K ^TMP($J,"IBOBL"),IBASK,IBADDCPT,IBCANC,IBX Q:$D(ZTQUEUED)
- D ^%ZISC
- Q
- ;
- FIND ; compile list of all related bills
- N IBIFN,IB0,DFN,IBEPDT,IBX
- ;
- ; compile list of related bills based on event date and opt visit dates of selected bill
- I +IBASK=2 S IBIFN=+$P(IBASK,U,2),IB0=$G(^DGCR(399,IBIFN,0)) D
- . S DFN=$P(IB0,U,2),IBEPDT=$P(IB0,U,3) D FIND1(DFN,IBEPDT)
- . S IBX=0 F S IBX=$O(^DGCR(399,+IBIFN,"OP",IBX)) Q:'IBX D
- .. S IBEPDT=+$G(^DGCR(399,+IBIFN,"OP",IBX,0)) Q:'IBEPDT D FIND1(DFN,IBEPDT)
- ;
- ; compile list of related bills based on selected patient and episode date
- I +IBASK=1 S DFN=$P(IBASK,U,2),IBEPDT=$P(IBASK,U,3) D FIND1(DFN,IBEPDT)
- ;
- D FIND2 ; compile list of bills based on Primary Bill link with bills already found
- Q
- ;
- FIND1(DFN,IBEPDT) ; find all bills for a patient with a specific event date or opt visit date
- N IBX,IBIFN,IBDT S IBEPDT=IBEPDT\1
- ;
- ; find all bills for patient with episode date as outpatient visit date
- S IBDT=IBEPDT-.0001 F S IBDT=$O(^DGCR(399,"AOPV",DFN,IBDT)) Q:((IBDT\1)'=IBEPDT) D
- . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AOPV",DFN,IBDT,IBIFN)) Q:'IBIFN D
- .. S IBX=$G(^DGCR(399,IBIFN,0)) I IBX="" Q
- .. S ^TMP($J,"IBOBL","BILL",IBIFN)=""
- .. I +$P(IBX,U,17) S ^TMP($J,"IBOBL","BILL",+$P(IBX,U,17))=""
- ;
- ; find all bills for patient with episode date as Event Date
- S IBDT=IBEPDT-.00001 F S IBDT=$O(^DGCR(399,"D",IBDT)) Q:((IBDT\1)'=IBEPDT) D
- . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"D",IBDT,IBIFN)) Q:'IBIFN D
- .. S IBX=$G(^DGCR(399,IBIFN,0)) I $P(IBX,U,2)'=DFN Q
- .. S ^TMP($J,"IBOBL","BILL",IBIFN)=""
- .. I +$P(IBX,U,17) S ^TMP($J,"IBOBL","BILL",+$P(IBX,U,17))=""
- ;
- Q
- ;
- FIND2 ; compile list of related bills based on Primary Bill of bills already found
- N IBBILL,IBIFN,IBX
- S IBBILL=0 F S IBBILL=$O(^TMP($J,"IBOBL","BILL",IBBILL)) Q:'IBBILL D
- . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AC",IBBILL,IBIFN)) Q:'IBIFN D
- .. S IBX=$G(^DGCR(399,IBIFN,0)) I IBX="" Q
- .. S ^TMP($J,"IBOBL","BILL",IBIFN)=""
- Q
- ;
- PRINT ;print the report from the temp sort file to the appropriate device
- N IBPGN,IBQUIT,IBLN,IBHDR1,IBHDR2,IBIFN
- S IBPGN=0,IBQUIT=0 D HDRLNS,HDR Q:IBQUIT
- ;
- S IBIFN=0 F S IBIFN=$O(^TMP($J,"IBOBL","BILL",IBIFN)) Q:'IBIFN D Q:$$LNCHK(2)
- . I '$G(IBCANC),$P($G(^DGCR(399,+IBIFN,0)),U,13)=7 Q
- . D PRTLN(IBIFN,IBADDCPT)
- ;
- I 'IBQUIT D PAUSE
- Q
- ;
- PRTLN(IBIFN,IBADDCPT) ; print one bill with all it's CPTs
- N IB0,IBU,IBM,IBMP,IBX,IBCPT S IBLN=IBLN+1
- S IB0=$G(^DGCR(399,+$G(IBIFN),0)) Q:IB0="" S IBU=$G(^DGCR(399,IBIFN,"U"))
- S IBM=$G(^DGCR(399,IBIFN,"M")),IBMP=$G(^DGCR(399,IBIFN,"MP"))
- W !,$P(IB0,U,1),?12,$P($G(^DGCR(399.3,+$P(IB0,U,7),0)),U,4) S IBX=$P(IB0,U,5)
- W ?24,$S(IBX=1:"INPT",IBX=2:"INPT-H",IBX=3:"OPT",IBX=4:"OPT-H",1:"") S IBX=$P(IB0,U,27)
- W ?32,$S(IBX=1:"INST",IBX=2:"PROF",1:"")
- W ?39,$$DATE(+$P(IB0,U,3)),?49,$$DATE(+IBU),?59,$$DATE(+$P(IBU,U,2))
- W ?70,$P($$ARSTATA^IBJTU4(IBIFN),U,2) S IBX=$P(IB0,U,21)
- W ?75,$S(IBX="P":"PRIM",IBX="S":"SEC",IBX="T":"TER",IBX="A":"PAT",1:"") S IBX=$P(IB0,U,11)
- W ?82,$E($S(IBX="i":$P($G(^DIC(36,+IBMP,0)),U,1),IBX="o":$P($G(^DIC(4,+$P(IBM,U,11),0)),U,1),IBX="p":$P($G(^DPT(+$P(IB0,U,2),0)),U,1),1:""),1,23)
- W ?107,$J(+$P($$BILL^RCJIBFN2(IBIFN),U,1),10,2)
- ;
- I 'IBADDCPT W ! Q
- ;
- S IBX=0 F S IBX=$O(^DGCR(399,IBIFN,"CP",IBX)) Q:'IBX D
- . S IBCPT=$P($G(^DGCR(399,IBIFN,"CP",IBX,0)),U,1) I IBCPT["ICPT" S IBCPT(+IBCPT)=+$G(IBCPT(+IBCPT))+1
- ;
- S IBCPT="" F S IBCPT=$O(IBCPT(IBCPT)) Q:'IBCPT D Q:$$LNCHK(1)
- . S IBX=+IBCPT(IBCPT) W ?120,$P($$CPT^ICPTCOD(+IBCPT),U,2),?127,$S(IBX'=1:"("_IBX_")",1:""),! S IBLN=IBLN+1
- ;
- Q
- ;
- HDR ;print the report header
- N IBNOW,IBI
- S IBQUIT=$$STOP Q:IBQUIT S IBPGN=IBPGN+1,IBLN=7
- S IBNOW=$$FMTE^XLFDT($$NOW^XLFDT),IBNOW=$P(IBNOW,"@",1)_" "_$P($P(IBNOW,"@",2),":",1,2)
- I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
- ;
- W !,IBHDR1,?(IOM-30),IBNOW,?(IOM-8),"PAGE ",IBPGN,!,IBHDR2
- W !,"BILL #",?12,"RATE",?24,"CLASSIFICATION",?39,"EVENT",?49,"FROM",?59,"TO",?70,"AR",?75,"COB",?82,"PAYER",?112,"TOTAL",?120,"CPT'S",!
- S IBI="",$P(IBI,"-",IOM+1)="" W IBI
- W !
- Q
- ;
- HDRLNS ; set up header lines
- N DFN,IBX S DFN=0
- S IBHDR1="EPISODE OF CARE BILL LIST FOR "
- I +IBASK=1 S IBHDR1=IBHDR1_$P($G(^DPT(+$P(IBASK,U,2),0)),U,1)_" ON "_$$DATE(+$P(IBASK,U,3)) S DFN=+$P(IBASK,U,2)
- I +IBASK=2 S IBX=$G(^DGCR(399,+$P(IBASK,U,2),0)),IBHDR1=IBHDR1_$P(IBX,U,1) S DFN=+$P(IBX,U,2)
- S IBX=$G(^DPT(DFN,0)) S IBHDR2=$P(IBX,U,1)_$J("",10)_$E(IBX)_$P($$PT^IBEFUNC(DFN),U,3)_$J("",10)_"DOB: "_$$DATE($P(IBX,U,3))
- Q
- ;
- DATE(X) ;
- Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
- ;
- LNCHK(LNS) ; check if new page is needed
- I 'IBQUIT,IBLN>(IOSL-LNS) D PAUSE I 'IBQUIT D HDR
- Q IBQUIT
- ;
- PAUSE ;pause at end of screen if beeing displayed on a terminal
- Q:$E(IOST,1,2)'["C-" N DIR,DUOUT,DTOUT,DIRUT
- S DIR(0)="E" D ^DIR K DIR
- I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
- Q
- ;
- STOP() ;determine if user has requested the queued report to stop
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
- Q +$G(ZTSTOP)
- ;
- CPT() ; return true if include bills CPT procedures
- N IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y S IBX=0
- S DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want the CPT procedures for each bill included in the report."
- S DIR("A")="Include CPT Procedures",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR S:Y=1 IBX=1 I $D(DIRUT) S IBX=-1
- Q IBX
- ;
- CANC() ; return true if include canceled bills
- N IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y S IBX=0
- S DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want cancelled bills included in the report."
- S DIR("A")="Include Cancelled Bills",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR S:Y=1 IBX=1 I $D(DIRUT) S IBX=-1
- Q IBX
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOBL 7033 printed Feb 18, 2025@23:51:47 Page 2
- IBOBL ;ALB/ARH - LIST ALL BILLS FOR AN EPISODE OF CARE ; 25-MAY-90
- +1 ;;2.0;INTEGRATED BILLING;**80,106**;21-MAR-94
- +2 ;
- EN ;get parameters then run the report
- +1 DO HOME^%ZIS
- NEW IBASK,IBCANC,IBX
- WRITE !!,"Episode of Care Bill List:",!,"--------------------------"
- +2 WRITE !,"Enter a Bill Number to get a list of all bills that match the selected bill's",!,"event date or any of it's outpatient visit dates."
- +3 WRITE !,"Enter a Patient Name and Episode Date to get a list of all bills for a patient",!,"that have either that date as the event date or as an outpatient visit date."
- +4 WRITE !,"This report also includes bills related as continuing episodes of care."
- +5 ;
- +6 SET IBASK=$$PB^IBJTU2
- if IBASK'>0
- QUIT
- WRITE !
- +7 IF +IBASK=1
- SET IBX=$$GETDT^IBCRU1("","Episode Date")
- if IBX'?7N
- QUIT
- SET IBASK=IBASK_U_IBX
- WRITE !
- +8 SET IBADDCPT=$$CPT
- if IBADDCPT<0
- QUIT
- +9 SET IBCANC=$$CANC
- if IBCANC<0
- QUIT
- WRITE !
- +10 ;
- DEV ;get the device
- +1 WRITE !,"Report requires 132 columns."
- +2 SET %ZIS="QM"
- SET %ZIS("A")="OUTPUT DEVICE: "
- DO ^%ZIS
- if POP
- GOTO EXIT
- +3 IF $DATA(IO("Q"))
- SET ZTRTN="RPT^IBOBL"
- SET ZTDESC="Episode of Care Bill List"
- SET ZTSAVE("IB*")=""
- DO ^%ZTLOAD
- KILL IO("Q")
- GOTO EXIT
- +4 USE IO
- +5 ;
- RPT ;find, save, and print the data that satisfies the search parameters
- +1 ;entry point for tasked jobs
- +2 ;
- +3 KILL ^TMP($JOB,"IBOBL")
- IF '$GET(IBASK)
- GOTO EXIT
- +4 ;
- +5 DO FIND
- +6 DO PRINT
- +7 ;
- EXIT ;clean up and quit
- +1 KILL ^TMP($JOB,"IBOBL"),IBASK,IBADDCPT,IBCANC,IBX
- if $DATA(ZTQUEUED)
- QUIT
- +2 DO ^%ZISC
- +3 QUIT
- +4 ;
- FIND ; compile list of all related bills
- +1 NEW IBIFN,IB0,DFN,IBEPDT,IBX
- +2 ;
- +3 ; compile list of related bills based on event date and opt visit dates of selected bill
- +4 IF +IBASK=2
- SET IBIFN=+$PIECE(IBASK,U,2)
- SET IB0=$GET(^DGCR(399,IBIFN,0))
- Begin DoDot:1
- +5 SET DFN=$PIECE(IB0,U,2)
- SET IBEPDT=$PIECE(IB0,U,3)
- DO FIND1(DFN,IBEPDT)
- +6 SET IBX=0
- FOR
- SET IBX=$ORDER(^DGCR(399,+IBIFN,"OP",IBX))
- if 'IBX
- QUIT
- Begin DoDot:2
- +7 SET IBEPDT=+$GET(^DGCR(399,+IBIFN,"OP",IBX,0))
- if 'IBEPDT
- QUIT
- DO FIND1(DFN,IBEPDT)
- End DoDot:2
- End DoDot:1
- +8 ;
- +9 ; compile list of related bills based on selected patient and episode date
- +10 IF +IBASK=1
- SET DFN=$PIECE(IBASK,U,2)
- SET IBEPDT=$PIECE(IBASK,U,3)
- DO FIND1(DFN,IBEPDT)
- +11 ;
- +12 ; compile list of bills based on Primary Bill link with bills already found
- DO FIND2
- +13 QUIT
- +14 ;
- FIND1(DFN,IBEPDT) ; find all bills for a patient with a specific event date or opt visit date
- +1 NEW IBX,IBIFN,IBDT
- SET IBEPDT=IBEPDT\1
- +2 ;
- +3 ; find all bills for patient with episode date as outpatient visit date
- +4 SET IBDT=IBEPDT-.0001
- FOR
- SET IBDT=$ORDER(^DGCR(399,"AOPV",DFN,IBDT))
- if ((IBDT\1)'=IBEPDT)
- QUIT
- Begin DoDot:1
- +5 SET IBIFN=0
- FOR
- SET IBIFN=$ORDER(^DGCR(399,"AOPV",DFN,IBDT,IBIFN))
- if 'IBIFN
- QUIT
- Begin DoDot:2
- +6 SET IBX=$GET(^DGCR(399,IBIFN,0))
- IF IBX=""
- QUIT
- +7 SET ^TMP($JOB,"IBOBL","BILL",IBIFN)=""
- +8 IF +$PIECE(IBX,U,17)
- SET ^TMP($JOB,"IBOBL","BILL",+$PIECE(IBX,U,17))=""
- End DoDot:2
- End DoDot:1
- +9 ;
- +10 ; find all bills for patient with episode date as Event Date
- +11 SET IBDT=IBEPDT-.00001
- FOR
- SET IBDT=$ORDER(^DGCR(399,"D",IBDT))
- if ((IBDT\1)'=IBEPDT)
- QUIT
- Begin DoDot:1
- +12 SET IBIFN=0
- FOR
- SET IBIFN=$ORDER(^DGCR(399,"D",IBDT,IBIFN))
- if 'IBIFN
- QUIT
- Begin DoDot:2
- +13 SET IBX=$GET(^DGCR(399,IBIFN,0))
- IF $PIECE(IBX,U,2)'=DFN
- QUIT
- +14 SET ^TMP($JOB,"IBOBL","BILL",IBIFN)=""
- +15 IF +$PIECE(IBX,U,17)
- SET ^TMP($JOB,"IBOBL","BILL",+$PIECE(IBX,U,17))=""
- End DoDot:2
- End DoDot:1
- +16 ;
- +17 QUIT
- +18 ;
- FIND2 ; compile list of related bills based on Primary Bill of bills already found
- +1 NEW IBBILL,IBIFN,IBX
- +2 SET IBBILL=0
- FOR
- SET IBBILL=$ORDER(^TMP($JOB,"IBOBL","BILL",IBBILL))
- if 'IBBILL
- QUIT
- Begin DoDot:1
- +3 SET IBIFN=0
- FOR
- SET IBIFN=$ORDER(^DGCR(399,"AC",IBBILL,IBIFN))
- if 'IBIFN
- QUIT
- Begin DoDot:2
- +4 SET IBX=$GET(^DGCR(399,IBIFN,0))
- IF IBX=""
- QUIT
- +5 SET ^TMP($JOB,"IBOBL","BILL",IBIFN)=""
- End DoDot:2
- End DoDot:1
- +6 QUIT
- +7 ;
- PRINT ;print the report from the temp sort file to the appropriate device
- +1 NEW IBPGN,IBQUIT,IBLN,IBHDR1,IBHDR2,IBIFN
- +2 SET IBPGN=0
- SET IBQUIT=0
- DO HDRLNS
- DO HDR
- if IBQUIT
- QUIT
- +3 ;
- +4 SET IBIFN=0
- FOR
- SET IBIFN=$ORDER(^TMP($JOB,"IBOBL","BILL",IBIFN))
- if 'IBIFN
- QUIT
- Begin DoDot:1
- +5 IF '$GET(IBCANC)
- IF $PIECE($GET(^DGCR(399,+IBIFN,0)),U,13)=7
- QUIT
- +6 DO PRTLN(IBIFN,IBADDCPT)
- End DoDot:1
- if $$LNCHK(2)
- QUIT
- +7 ;
- +8 IF 'IBQUIT
- DO PAUSE
- +9 QUIT
- +10 ;
- PRTLN(IBIFN,IBADDCPT) ; print one bill with all it's CPTs
- +1 NEW IB0,IBU,IBM,IBMP,IBX,IBCPT
- SET IBLN=IBLN+1
- +2 SET IB0=$GET(^DGCR(399,+$GET(IBIFN),0))
- if IB0=""
- QUIT
- SET IBU=$GET(^DGCR(399,IBIFN,"U"))
- +3 SET IBM=$GET(^DGCR(399,IBIFN,"M"))
- SET IBMP=$GET(^DGCR(399,IBIFN,"MP"))
- +4 WRITE !,$PIECE(IB0,U,1),?12,$PIECE($GET(^DGCR(399.3,+$PIECE(IB0,U,7),0)),U,4)
- SET IBX=$PIECE(IB0,U,5)
- +5 WRITE ?24,$SELECT(IBX=1:"INPT",IBX=2:"INPT-H",IBX=3:"OPT",IBX=4:"OPT-H",1:"")
- SET IBX=$PIECE(IB0,U,27)
- +6 WRITE ?32,$SELECT(IBX=1:"INST",IBX=2:"PROF",1:"")
- +7 WRITE ?39,$$DATE(+$PIECE(IB0,U,3)),?49,$$DATE(+IBU),?59,$$DATE(+$PIECE(IBU,U,2))
- +8 WRITE ?70,$PIECE($$ARSTATA^IBJTU4(IBIFN),U,2)
- SET IBX=$PIECE(IB0,U,21)
- +9 WRITE ?75,$SELECT(IBX="P":"PRIM",IBX="S":"SEC",IBX="T":"TER",IBX="A":"PAT",1:"")
- SET IBX=$PIECE(IB0,U,11)
- +10 WRITE ?82,$EXTRACT($SELECT(IBX="i":$PIECE($GET(^DIC(36,+IBMP,0)),U,1),IBX="o":$PIECE($GET(^DIC(4,+$PIECE(IBM,U,11),0)),U,1),IBX="p":$PIECE($GET(^DPT(+$PIECE(IB0,U,2),0)),U,1),1:""),1,23)
- +11 WRITE ?107,$JUSTIFY(+$PIECE($$BILL^RCJIBFN2(IBIFN),U,1),10,2)
- +12 ;
- +13 IF 'IBADDCPT
- WRITE !
- QUIT
- +14 ;
- +15 SET IBX=0
- FOR
- SET IBX=$ORDER(^DGCR(399,IBIFN,"CP",IBX))
- if 'IBX
- QUIT
- Begin DoDot:1
- +16 SET IBCPT=$PIECE($GET(^DGCR(399,IBIFN,"CP",IBX,0)),U,1)
- IF IBCPT["ICPT"
- SET IBCPT(+IBCPT)=+$GET(IBCPT(+IBCPT))+1
- End DoDot:1
- +17 ;
- +18 SET IBCPT=""
- FOR
- SET IBCPT=$ORDER(IBCPT(IBCPT))
- if 'IBCPT
- QUIT
- Begin DoDot:1
- +19 SET IBX=+IBCPT(IBCPT)
- WRITE ?120,$PIECE($$CPT^ICPTCOD(+IBCPT),U,2),?127,$SELECT(IBX'=1:"("_IBX_")",1:""),!
- SET IBLN=IBLN+1
- End DoDot:1
- if $$LNCHK(1)
- QUIT
- +20 ;
- +21 QUIT
- +22 ;
- HDR ;print the report header
- +1 NEW IBNOW,IBI
- +2 SET IBQUIT=$$STOP
- if IBQUIT
- QUIT
- SET IBPGN=IBPGN+1
- SET IBLN=7
- +3 SET IBNOW=$$FMTE^XLFDT($$NOW^XLFDT)
- SET IBNOW=$PIECE(IBNOW,"@",1)_" "_$PIECE($PIECE(IBNOW,"@",2),":",1,2)
- +4 IF IBPGN>1!($EXTRACT(IOST,1,2)["C-")
- WRITE @IOF
- +5 ;
- +6 WRITE !,IBHDR1,?(IOM-30),IBNOW,?(IOM-8),"PAGE ",IBPGN,!,IBHDR2
- +7 WRITE !,"BILL #",?12,"RATE",?24,"CLASSIFICATION",?39,"EVENT",?49,"FROM",?59,"TO",?70,"AR",?75,"COB",?82,"PAYER",?112,"TOTAL",?120,"CPT'S",!
- +8 SET IBI=""
- SET $PIECE(IBI,"-",IOM+1)=""
- WRITE IBI
- +9 WRITE !
- +10 QUIT
- +11 ;
- HDRLNS ; set up header lines
- +1 NEW DFN,IBX
- SET DFN=0
- +2 SET IBHDR1="EPISODE OF CARE BILL LIST FOR "
- +3 IF +IBASK=1
- SET IBHDR1=IBHDR1_$PIECE($GET(^DPT(+$PIECE(IBASK,U,2),0)),U,1)_" ON "_$$DATE(+$PIECE(IBASK,U,3))
- SET DFN=+$PIECE(IBASK,U,2)
- +4 IF +IBASK=2
- SET IBX=$GET(^DGCR(399,+$PIECE(IBASK,U,2),0))
- SET IBHDR1=IBHDR1_$PIECE(IBX,U,1)
- SET DFN=+$PIECE(IBX,U,2)
- +5 SET IBX=$GET(^DPT(DFN,0))
- SET IBHDR2=$PIECE(IBX,U,1)_$JUSTIFY("",10)_$EXTRACT(IBX)_$PIECE($$PT^IBEFUNC(DFN),U,3)_$JUSTIFY("",10)_"DOB: "_$$DATE($PIECE(IBX,U,3))
- +6 QUIT
- +7 ;
- DATE(X) ;
- +1 QUIT $EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
- +2 ;
- LNCHK(LNS) ; check if new page is needed
- +1 IF 'IBQUIT
- IF IBLN>(IOSL-LNS)
- DO PAUSE
- IF 'IBQUIT
- DO HDR
- +2 QUIT IBQUIT
- +3 ;
- PAUSE ;pause at end of screen if beeing displayed on a terminal
- +1 if $EXTRACT(IOST,1,2)'["C-"
- QUIT
- NEW DIR,DUOUT,DTOUT,DIRUT
- +2 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DUOUT)!($DATA(DIRUT))
- SET IBQUIT=1
- +4 QUIT
- +5 ;
- STOP() ;determine if user has requested the queued report to stop
- +1 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- IF +$GET(IBPGN)
- WRITE !,"***TASK STOPPED BY USER***"
- +2 QUIT +$GET(ZTSTOP)
- +3 ;
- CPT() ; return true if include bills CPT procedures
- +1 NEW IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y
- SET IBX=0
- +2 SET DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want the CPT procedures for each bill included in the report."
- +3 SET DIR("A")="Include CPT Procedures"
- SET DIR(0)="Y"
- SET DIR("B")="No"
- DO ^DIR
- KILL DIR
- if Y=1
- SET IBX=1
- IF $DATA(DIRUT)
- SET IBX=-1
- +4 QUIT IBX
- +5 ;
- CANC() ; return true if include canceled bills
- +1 NEW IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y
- SET IBX=0
- +2 SET DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want cancelled bills included in the report."
- +3 SET DIR("A")="Include Cancelled Bills"
- SET DIR(0)="Y"
- SET DIR("B")="No"
- DO ^DIR
- KILL DIR
- if Y=1
- SET IBX=1
- IF $DATA(DIRUT)
- SET IBX=-1
- +4 QUIT IBX