IBJDI6 ;ALB/CPM - SC VETS W/ NSC EPISODES OF INPT CARE ; 18-DEC-96
;;2.0;INTEGRATED BILLING;**69,83,98,100**;21-MAR-94
;
EN ; - Option entry point.
;
W !!,"This report provides a number of the NSC inpatient episodes for SC veterans"
W !,"which have and have not been billed.",!
;
DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
;
; - Select a detailed or summary report.
D DS^IBJD I IBRPT["^" G ENQ
;
W !!,"This report only requires an 80 column printer."
;
W !!,"Note: This report may take a while to run."
W !?6,"You should queue this report to run after normal business hours.",!
;
; - Select a device.
S %ZIS="QM" D ^%ZIS G:POP ENQ
I $D(IO("Q")) D G ENQ
.S ZTRTN="DQ^IBJDI6",ZTDESC="IB - SC VETS W/ NSC EPISODES"
.F I="IBBDT","IBEDT","IBRPT" S ZTSAVE(I)=""
.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.
;
I $G(IBXTRACT) D E^IBJDE(6,1) ; Change extract status.
;
K IB,^TMP("IBJDI6",$J)
S IBQ=0 F X="NSC","NSCB","NSCR","NSCU","SC","TOT" S IB(X)=0
F X=0:1:3 S IB("NSCU",X)=0
;
; - Find data required for the report.
S IBD=IBBDT-.01 F S IBD=$O(^DGPM("ATT3",IBD)) Q:'IBD!(IBD\1>IBEDT) D Q:IBQ
.S IBPM=0 F S IBPM=$O(^DGPM("ATT3",IBD,IBPM)) Q:'IBPM D Q:IBQ
..I IBPM#100=0 S IBQ=$$STOP^IBOUTL("SC Vets w/NSC Episodes") Q:IBQ
..S IBPMD=$G(^DGPM(IBPM,0)) Q:'IBPMD
..S DFN=+$P(IBPMD,U,3) Q:'DFN
..I $$TESTP^IBJDI1(DFN) Q ; Test patient.
..S IBDIS=+IBPMD\1
..;
..; - Patient must be insured, and SC.
..I '$$INSURED^IBCNS1(DFN,IBDIS) Q
..D ELIG^VADPT Q:'VAEL(3)
..;
..; - Set 'totals' accumulator.
..S IB("TOT")=IB("TOT")+1
..;
..; - See if associated PTF record has NSC movements.
..S IBADMD=$G(^DGPM(+$P(IBPMD,U,14),0))
..S IBPTF=+$P(IBADMD,U,16),IBSTAT=$P($G(^DGPT(IBPTF,0)),U,6)
..I '$$PTF(IBPTF) S IB("SC")=IB("SC")+1 Q
..S IB("NSC")=IB("NSC")+1
..;
..; - See if there is a claim for the NSC episode.
..S IBADM=+IBADMD\1
..I $$BILL(IBPTF,DFN,IBADM,IBDIS) S IB("NSCB")=IB("NSCB")+1 Q
..;
..; - Has episode been flagged as non-billable?
..S IBCT=$O(^IBT(356,"AD",+$P(IBPMD,U,14),0))
..I IBCT,$P($G(^IBT(356,IBCT,0)),U,19) S IB("NSCR")=IB("NSCR")+1 Q
..;
..S IB("NSCU")=IB("NSCU")+1
..S IB("NSCU",IBSTAT)=IB("NSCU",IBSTAT)+1
..I IBRPT="D" D
...S X=$G(^DPT(DFN,0))
...S ^TMP("IBJDI6",$J,$P(X,U)_"@@"_DFN)=$P(X,U,9)
...S ^TMP("IBJDI6",$J,$P(X,U)_"@@"_DFN,IBADM)=$S(IBSTAT=0:"OPEN",IBSTAT=1:"CLOSED",IBSTAT=2:"RELEASED",1:"TRANSMITTED")_U_IBDIS
;
I IBQ G ENQ
;
I $G(IBXTRACT) D E^IBJDE(6,0) G ENQ ; Extract summary data.
;
; - Print the reports.
S (IBPAG,IBQ)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
I IBRPT="D" D DET
I 'IBQ D SUM
;
I 'IBQ D PAUSE
;
ENQ K ^TMP("IBJDI6",$J)
I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
;
D ^%ZISC
ENQ1 K IB,IBQ,IBBDT,IBEDT,IBRPT,IBD,IBDN,IBPAG,IBRUN,IBX,IBX1,IBX2
K IBADM,IBDIS,IBCT,IBH,IBPER,IBPM,IBPMD,IBPMDT,IBPTF,IBSTAT,IBADMD
K %,%ZIS,DFN,POP,VA,VAERR,VAEL,X,Y,ZTDESC,ZTRTN,ZTSAVE
Q
;
DET ; - Print the detailed report.
D HDET Q:IBQ
I '$D(^TMP("IBJDI6",$J)) D G DETQ
.I IB("NSC") W !!,"All NSC episodes for SC veterans in the selected date range have been billed." Q
.W !!,"There were no NSC episodes found in the selected date range."
;
S IBX="" F S IBX=$O(^TMP("IBJDI6",$J,IBX)) Q:IBX="" S IBX1=^(IBX) D Q:IBQ
.S (IBH,IBADM)=0 F S IBADM=$O(^TMP("IBJDI6",$J,IBX,IBADM)) Q:'IBADM S IBX2=^(IBADM) D Q:IBQ
..I $Y>(IOSL-2) D PAUSE Q:IBQ D HDET Q:IBQ S IBH=0
..W ! I 'IBH D PAT S IBH=1
..W ?46,$P(IBX2,U),?59,$$DAT1^IBOUTL(IBADM),?69,$$DAT1^IBOUTL($P(IBX2,U,2))
;
DETQ I 'IBQ D PAUSE
Q
;
PAT ; - Write the patient information.
W $P(IBX,"@@"),?32,$$SSN(IBX1)
Q
;
HDET ; - Write the detail report header.
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
S IBPAG=IBPAG+1
W !,"Insured SC Vets w/ Unbilled NSC Care",?38,"Run Date: ",IBRUN,?70,"Page: ",IBPAG
W !,"For Patients discharged in the period "_$$DAT1^IBOUTL(IBBDT)_" to "_$$DAT1^IBOUTL(IBEDT)
W !,"Patient",?32,"SSN",?46,"PTF Status",?59,"Adm Date",?69,"Disc Date"
W !,$$DASH(80)
S IBQ=$$STOP^IBOUTL("SC Vets w/NSC Episodes")
Q
;
SUM ; - Print the summary report.
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
S IBPAG=IBPAG+1
W !!?13,"INSURED SC VETERANS W/ UNBILLED NSC INPATIENT EPISODES"
W !?33,"SUMMARY REPORT"
W !!?16,"For Patients discharged from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
W !!?24,"Run Date: ",IBRUN,!?24,$$DASH(31),!!
;
S IBPER(1)=$S('IB("TOT"):0,1:$J(IB("SC")/IB("TOT")*100,0,2))
S IBPER(2)=$S('IB("NSC"):0,1:$J(IB("NSCB")/IB("NSC")*100,0,2))
S IBPER(3)=$S('IB("NSC"):0,1:$J(IB("NSCR")/IB("NSC")*100,0,2))
W ?9,"Number of Discharges of Insured SC Veterans:",?54,$J(IB("TOT"),4)
W !?5,"Discharges Which were totally Service-Connected:",?54,$J(IB("SC"),4),?62,"(",IBPER(1),"%)"
W !,"Discharges Which included Non-Service Connected Care:",?54,$J(IB("NSC"),4),?62,"(",$J($S('IB("TOT"):0,1:100-IBPER(1)),0,2),"%)"
W !?10,"Number of NSC Discharges Which were Billed:",?54,$J(IB("NSCB"),4),?62,"(",IBPER(2),"%)"
W !?4,"Number of NSC Discharges Flagged as Non-Billable:",?54,$J(IB("NSCR"),4),?62,"(",IBPER(3),"%)"
W !?19,"Number of Unbilled NSC Discharges:",?54,$J(IB("NSCU"),4),?62,"(",$J($S('IB("NSC"):0,1:100-IBPER(2)-IBPER(3)),0,2),"%)",!?54,"----"
F X=0:1:3 D
.I X=0 W !,"Unbilled NSC Discharges w/ PTF Status of"
.W ?41,$S(X=0:"Open",X=1:"Closed",X=2:"Released",1:"Transmitted"),":",?54,$J(IB("NSCU",X),4),?62,"(",$J($S('IB("NSCU",X):0,1:IB("NSCU",X)/IB("NSCU")*100),0,2),"%)",!
Q
;
DASH(X) ; - Return a dashed line.
Q $TR($J("",X)," ","=")
;
PAUSE ; - Page break.
I $E(IOST,1,2)'="C-" Q
N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
F IBX=$Y:1:(IOSL-3) W !
S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
Q
;
SSN(X) ; - Format the SSN.
Q $S(X]"":$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),1:"")
;
PTF(IBPTF) ; - Does the PTF record have an NSC-related movement?
; Input: IBPTF = Pointer to the PTF record in file #45
; Output: IBNSC = 1 (NSC movement) or 0 (No NSC movement)
;
N IBNSC,X,Y
S (IBNSC,X)=0
I '$G(IBPTF) G PTFQ
;
; - Check PTF movements for a movement not related to SC care.
F S X=$O(^DGPT(IBPTF,"M",X)) Q:'X S Y=$P($G(^(X,0)),U,18) I Y'=1 S IBNSC=1 Q
;
PTFQ Q IBNSC
;
BILL(IBPTF,DFN,IBADM,IBDIS) ; - Has this episode of care been billed?
; Input: IBPTF = Pointer to the PTF record in file #45
; DFN = Pointer to the patient in file #2
; IBADM = Episode admission date
; IBDIS = Episode discharge date
; Output: BILL = 1 (Episode has been billed)
; 0 (Episode has not been billed)
;
N BILL,X,X1,XU,Y
S BILL=0
;
; - See if there is a claim based on the PTF record.
I $G(IBPTF) D G:BILL BILLQ
.S X=0 F S X=$O(^DGCR(399,"APTF",IBPTF,X)) Q:'X S Y=$P($G(^DGCR(399,X,0)),U,13) I Y,Y<7 S BILL=1 Q
;
; - Check other inpatient bills for care provided in the adm/dis period.
S X=0 F S X=$O(^DGCR(399,"C",+$G(DFN),X)) Q:'X D Q:BILL
.S X1=$G(^DGCR(399,X,0)),XU=$G(^("U")) Q:X1=""
.I $P(X1,U,5)>2 Q ; Outpatient care.
.I $P(X1,U,13)=7 Q ; Bill is cancelled.
.I +XU\1<IBADM!($P(XU,U,2)\1>IBEDT) Q ; Care outside of range.
.S BILL=1
;
BILLQ Q BILL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDI6 7437 printed Nov 22, 2024@17:33:25 Page 2
IBJDI6 ;ALB/CPM - SC VETS W/ NSC EPISODES OF INPT CARE ; 18-DEC-96
+1 ;;2.0;INTEGRATED BILLING;**69,83,98,100**;21-MAR-94
+2 ;
EN ; - Option entry point.
+1 ;
+2 WRITE !!,"This report provides a number of the NSC inpatient episodes for SC veterans"
+3 WRITE !,"which have and have not been billed.",!
+4 ;
DATE DO DATE^IBOUTL
IF IBBDT=""!(IBEDT="")
GOTO ENQ
+1 ;
+2 ; - Select a detailed or summary report.
+3 DO DS^IBJD
IF IBRPT["^"
GOTO ENQ
+4 ;
+5 WRITE !!,"This report only requires an 80 column printer."
+6 ;
+7 WRITE !!,"Note: This report may take a while to run."
+8 WRITE !?6,"You should queue this report to run after normal business hours.",!
+9 ;
+10 ; - Select a device.
+11 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO ENQ
+12 IF $DATA(IO("Q"))
Begin DoDot:1
+13 SET ZTRTN="DQ^IBJDI6"
SET ZTDESC="IB - SC VETS W/ NSC EPISODES"
+14 FOR I="IBBDT","IBEDT","IBRPT"
SET ZTSAVE(I)=""
+15 DO ^%ZTLOAD
+16 WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+17 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO ENQ
+18 ;
+19 USE IO
+20 ;
DQ ; - Tasked entry point.
+1 ;
+2 ; Change extract status.
IF $GET(IBXTRACT)
DO E^IBJDE(6,1)
+3 ;
+4 KILL IB,^TMP("IBJDI6",$JOB)
+5 SET IBQ=0
FOR X="NSC","NSCB","NSCR","NSCU","SC","TOT"
SET IB(X)=0
+6 FOR X=0:1:3
SET IB("NSCU",X)=0
+7 ;
+8 ; - Find data required for the report.
+9 SET IBD=IBBDT-.01
FOR
SET IBD=$ORDER(^DGPM("ATT3",IBD))
if 'IBD!(IBD\1>IBEDT)
QUIT
Begin DoDot:1
+10 SET IBPM=0
FOR
SET IBPM=$ORDER(^DGPM("ATT3",IBD,IBPM))
if 'IBPM
QUIT
Begin DoDot:2
+11 IF IBPM#100=0
SET IBQ=$$STOP^IBOUTL("SC Vets w/NSC Episodes")
if IBQ
QUIT
+12 SET IBPMD=$GET(^DGPM(IBPM,0))
if 'IBPMD
QUIT
+13 SET DFN=+$PIECE(IBPMD,U,3)
if 'DFN
QUIT
+14 ; Test patient.
IF $$TESTP^IBJDI1(DFN)
QUIT
+15 SET IBDIS=+IBPMD\1
+16 ;
+17 ; - Patient must be insured, and SC.
+18 IF '$$INSURED^IBCNS1(DFN,IBDIS)
QUIT
+19 DO ELIG^VADPT
if 'VAEL(3)
QUIT
+20 ;
+21 ; - Set 'totals' accumulator.
+22 SET IB("TOT")=IB("TOT")+1
+23 ;
+24 ; - See if associated PTF record has NSC movements.
+25 SET IBADMD=$GET(^DGPM(+$PIECE(IBPMD,U,14),0))
+26 SET IBPTF=+$PIECE(IBADMD,U,16)
SET IBSTAT=$PIECE($GET(^DGPT(IBPTF,0)),U,6)
+27 IF '$$PTF(IBPTF)
SET IB("SC")=IB("SC")+1
QUIT
+28 SET IB("NSC")=IB("NSC")+1
+29 ;
+30 ; - See if there is a claim for the NSC episode.
+31 SET IBADM=+IBADMD\1
+32 IF $$BILL(IBPTF,DFN,IBADM,IBDIS)
SET IB("NSCB")=IB("NSCB")+1
QUIT
+33 ;
+34 ; - Has episode been flagged as non-billable?
+35 SET IBCT=$ORDER(^IBT(356,"AD",+$PIECE(IBPMD,U,14),0))
+36 IF IBCT
IF $PIECE($GET(^IBT(356,IBCT,0)),U,19)
SET IB("NSCR")=IB("NSCR")+1
QUIT
+37 ;
+38 SET IB("NSCU")=IB("NSCU")+1
+39 SET IB("NSCU",IBSTAT)=IB("NSCU",IBSTAT)+1
+40 IF IBRPT="D"
Begin DoDot:3
+41 SET X=$GET(^DPT(DFN,0))
+42 SET ^TMP("IBJDI6",$JOB,$PIECE(X,U)_"@@"_DFN)=$PIECE(X,U,9)
+43 SET ^TMP("IBJDI6",$JOB,$PIECE(X,U)_"@@"_DFN,IBADM)=$SELECT(IBSTAT=0:"OPEN",IBSTAT=1:"CLOSED",IBSTAT=2:"RELEASED",1:"TRANSMITTED")_U_IBDIS
End DoDot:3
End DoDot:2
if IBQ
QUIT
End DoDot:1
if IBQ
QUIT
+44 ;
+45 IF IBQ
GOTO ENQ
+46 ;
+47 ; Extract summary data.
IF $GET(IBXTRACT)
DO E^IBJDE(6,0)
GOTO ENQ
+48 ;
+49 ; - Print the reports.
+50 SET (IBPAG,IBQ)=0
DO NOW^%DTC
SET IBRUN=$$DAT2^IBOUTL(%)
+51 IF IBRPT="D"
DO DET
+52 IF 'IBQ
DO SUM
+53 ;
+54 IF 'IBQ
DO PAUSE
+55 ;
ENQ KILL ^TMP("IBJDI6",$JOB)
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
GOTO ENQ1
+2 ;
+3 DO ^%ZISC
ENQ1 KILL IB,IBQ,IBBDT,IBEDT,IBRPT,IBD,IBDN,IBPAG,IBRUN,IBX,IBX1,IBX2
+1 KILL IBADM,IBDIS,IBCT,IBH,IBPER,IBPM,IBPMD,IBPMDT,IBPTF,IBSTAT,IBADMD
+2 KILL %,%ZIS,DFN,POP,VA,VAERR,VAEL,X,Y,ZTDESC,ZTRTN,ZTSAVE
+3 QUIT
+4 ;
DET ; - Print the detailed report.
+1 DO HDET
if IBQ
QUIT
+2 IF '$DATA(^TMP("IBJDI6",$JOB))
Begin DoDot:1
+3 IF IB("NSC")
WRITE !!,"All NSC episodes for SC veterans in the selected date range have been billed."
QUIT
+4 WRITE !!,"There were no NSC episodes found in the selected date range."
End DoDot:1
GOTO DETQ
+5 ;
+6 SET IBX=""
FOR
SET IBX=$ORDER(^TMP("IBJDI6",$JOB,IBX))
if IBX=""
QUIT
SET IBX1=^(IBX)
Begin DoDot:1
+7 SET (IBH,IBADM)=0
FOR
SET IBADM=$ORDER(^TMP("IBJDI6",$JOB,IBX,IBADM))
if 'IBADM
QUIT
SET IBX2=^(IBADM)
Begin DoDot:2
+8 IF $Y>(IOSL-2)
DO PAUSE
if IBQ
QUIT
DO HDET
if IBQ
QUIT
SET IBH=0
+9 WRITE !
IF 'IBH
DO PAT
SET IBH=1
+10 WRITE ?46,$PIECE(IBX2,U),?59,$$DAT1^IBOUTL(IBADM),?69,$$DAT1^IBOUTL($PIECE(IBX2,U,2))
End DoDot:2
if IBQ
QUIT
End DoDot:1
if IBQ
QUIT
+11 ;
DETQ IF 'IBQ
DO PAUSE
+1 QUIT
+2 ;
PAT ; - Write the patient information.
+1 WRITE $PIECE(IBX,"@@"),?32,$$SSN(IBX1)
+2 QUIT
+3 ;
HDET ; - Write the detail report header.
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF,*13
+2 SET IBPAG=IBPAG+1
+3 WRITE !,"Insured SC Vets w/ Unbilled NSC Care",?38,"Run Date: ",IBRUN,?70,"Page: ",IBPAG
+4 WRITE !,"For Patients discharged in the period "_$$DAT1^IBOUTL(IBBDT)_" to "_$$DAT1^IBOUTL(IBEDT)
+5 WRITE !,"Patient",?32,"SSN",?46,"PTF Status",?59,"Adm Date",?69,"Disc Date"
+6 WRITE !,$$DASH(80)
+7 SET IBQ=$$STOP^IBOUTL("SC Vets w/NSC Episodes")
+8 QUIT
+9 ;
SUM ; - Print the summary report.
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF,*13
+2 SET IBPAG=IBPAG+1
+3 WRITE !!?13,"INSURED SC VETERANS W/ UNBILLED NSC INPATIENT EPISODES"
+4 WRITE !?33,"SUMMARY REPORT"
+5 WRITE !!?16,"For Patients discharged from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
+6 WRITE !!?24,"Run Date: ",IBRUN,!?24,$$DASH(31),!!
+7 ;
+8 SET IBPER(1)=$SELECT('IB("TOT"):0,1:$JUSTIFY(IB("SC")/IB("TOT")*100,0,2))
+9 SET IBPER(2)=$SELECT('IB("NSC"):0,1:$JUSTIFY(IB("NSCB")/IB("NSC")*100,0,2))
+10 SET IBPER(3)=$SELECT('IB("NSC"):0,1:$JUSTIFY(IB("NSCR")/IB("NSC")*100,0,2))
+11 WRITE ?9,"Number of Discharges of Insured SC Veterans:",?54,$JUSTIFY(IB("TOT"),4)
+12 WRITE !?5,"Discharges Which were totally Service-Connected:",?54,$JUSTIFY(IB("SC"),4),?62,"(",IBPER(1),"%)"
+13 WRITE !,"Discharges Which included Non-Service Connected Care:",?54,$JUSTIFY(IB("NSC"),4),?62,"(",$JUSTIFY($SELECT('IB("TOT"):0,1:100-IBPER(1)),0,2),"%)"
+14 WRITE !?10,"Number of NSC Discharges Which were Billed:",?54,$JUSTIFY(IB("NSCB"),4),?62,"(",IBPER(2),"%)"
+15 WRITE !?4,"Number of NSC Discharges Flagged as Non-Billable:",?54,$JUSTIFY(IB("NSCR"),4),?62,"(",IBPER(3),"%)"
+16 WRITE !?19,"Number of Unbilled NSC Discharges:",?54,$JUSTIFY(IB("NSCU"),4),?62,"(",$JUSTIFY($SELECT('IB("NSC"):0,1:100-IBPER(2)-IBPER(3)),0,2),"%)",!?54,"----"
+17 FOR X=0:1:3
Begin DoDot:1
+18 IF X=0
WRITE !,"Unbilled NSC Discharges w/ PTF Status of"
+19 WRITE ?41,$SELECT(X=0:"Open",X=1:"Closed",X=2:"Released",1:"Transmitted"),":",?54,$JUSTIFY(IB("NSCU",X),4),?62,"(",$JUSTIFY($SELECT('IB("NSCU",X):0,1:IB("NSCU",X)/IB("NSCU")*100),0,2),"%)",!
End DoDot:1
+20 QUIT
+21 ;
DASH(X) ; - Return a dashed line.
+1 QUIT $TRANSLATE($JUSTIFY("",X)," ","=")
+2 ;
PAUSE ; - Page break.
+1 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 NEW IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 FOR IBX=$Y:1:(IOSL-3)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQ=1
+5 QUIT
+6 ;
SSN(X) ; - Format the SSN.
+1 QUIT $SELECT(X]"":$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10),1:"")
+2 ;
PTF(IBPTF) ; - Does the PTF record have an NSC-related movement?
+1 ; Input: IBPTF = Pointer to the PTF record in file #45
+2 ; Output: IBNSC = 1 (NSC movement) or 0 (No NSC movement)
+3 ;
+4 NEW IBNSC,X,Y
+5 SET (IBNSC,X)=0
+6 IF '$GET(IBPTF)
GOTO PTFQ
+7 ;
+8 ; - Check PTF movements for a movement not related to SC care.
+9 FOR
SET X=$ORDER(^DGPT(IBPTF,"M",X))
if 'X
QUIT
SET Y=$PIECE($GET(^(X,0)),U,18)
IF Y'=1
SET IBNSC=1
QUIT
+10 ;
PTFQ QUIT IBNSC
+1 ;
BILL(IBPTF,DFN,IBADM,IBDIS) ; - Has this episode of care been billed?
+1 ; Input: IBPTF = Pointer to the PTF record in file #45
+2 ; DFN = Pointer to the patient in file #2
+3 ; IBADM = Episode admission date
+4 ; IBDIS = Episode discharge date
+5 ; Output: BILL = 1 (Episode has been billed)
+6 ; 0 (Episode has not been billed)
+7 ;
+8 NEW BILL,X,X1,XU,Y
+9 SET BILL=0
+10 ;
+11 ; - See if there is a claim based on the PTF record.
+12 IF $GET(IBPTF)
Begin DoDot:1
+13 SET X=0
FOR
SET X=$ORDER(^DGCR(399,"APTF",IBPTF,X))
if 'X
QUIT
SET Y=$PIECE($GET(^DGCR(399,X,0)),U,13)
IF Y
IF Y<7
SET BILL=1
QUIT
End DoDot:1
if BILL
GOTO BILLQ
+14 ;
+15 ; - Check other inpatient bills for care provided in the adm/dis period.
+16 SET X=0
FOR
SET X=$ORDER(^DGCR(399,"C",+$GET(DFN),X))
if 'X
QUIT
Begin DoDot:1
+17 SET X1=$GET(^DGCR(399,X,0))
SET XU=$GET(^("U"))
if X1=""
QUIT
+18 ; Outpatient care.
IF $PIECE(X1,U,5)>2
QUIT
+19 ; Bill is cancelled.
IF $PIECE(X1,U,13)=7
QUIT
+20 ; Care outside of range.
IF +XU\1<IBADM!($PIECE(XU,U,2)\1>IBEDT)
QUIT
+21 SET BILL=1
End DoDot:1
if BILL
QUIT
+22 ;
BILLQ QUIT BILL
