SDSCRP2 ;ALB/JAM/RBS - Recovered Costs Report for ASCD ; 3/13/07 2:50pm
;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
;;known as Service Connected Automated Monitoring (SCAM).
;
;**Program Description**
; This program will report on all bills generated and amounts
; received for encounters whose Service Connected was changed
; from 'Yes' to 'No'.
Q
EN ; Entry point - find all records
; Get Division
N SDSCDVSL,SDSCDVLN,SDRUN,ZTDESC,ZTRTN,ZTIO,ZTSAVE,DIR,X,Y
D DIV^SDSCUTL
D ^DIR
I $G(DTOUT)!($G(DUOUT)) G EXIT
S SDSCDVSL=Y,SDSCDVLN=SCLN K DIR,Y,X,SCLN
S SDRUN=$$HTE^XLFDT($H,1),ZTDESC="RECOVERED COSTS REPORT",ZTRTN="BEG^SDSCRP2"
; Get start and end date for report.
D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
W !!,"You will need a 132 column printer for this report!",!
K %ZIS S %ZIS="QM" D ^%ZIS G EXIT:POP
I '$D(IO("Q")) K ZTDESC G @ZTRTN
S ZTIO=ION,ZTSAVE("*")=""
D ^%ZTLOAD
G EXIT
;
BEG ; Begin report
N P,L,SDABRT,CT,SDSCDIV,SDSCDNM,THDR,SDI,DFTOTB,DFTOTP,DTTOTB,DTTOTP
S (P,L,SDABRT,CT)=0
S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
I SDSCDIV="" S SDSCDNM="ALL" D FND G EXT
I SDSCDIV'="" D
. S THDR=""
. F SDI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",SDI) Q:SDSCDIV="" D Q:$G(SDABRT)=1
.. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1 D FND
G EXT
;
FND ; Find records
N SDATA,SDOEDT,SDOE,DFN,ENCDT,SDCLM,GTOTB,GTOTP,FTOTB,FTOTP,TTOTB,TTOTP
N BILN,TCHRG,TPAY,AUTHDT,SDWHO,PYMDT,ENCDT,SDSCD,SDPAT,VADM,SCVAL,SDBTR
K ^TMP($J,"SDSCBILL")
S SDOEDT=SDSCTDT
F S SDOEDT=$O(^SDSC(409.48,"C","C",SDOEDT)) Q:SDOEDT=""!(SDOEDT\1>SDEDT) D
. S SDOE=0
. F S SDOE=$O(^SDSC(409.48,"C","C",SDOEDT,SDOE)) Q:'SDOE D
.. S SDATA=$G(^SDSC(409.48,SDOE,0)) I SDATA="" Q
.. I $P(SDATA,U,5)'="C" Q
.. I SDSCDIV'="" Q:$P(SDATA,U,12)'=SDSCDIV
.. I '+$$GETOE^SDOE(SDOE) Q
.. ;find only encounters that were changed by ASCD from SC to NSC
.. S SCVAL=$$SCHNG^SDSCUTL(SDOE) I '+SCVAL Q
.. I $P(SCVAL,U,3) Q
.. D FPCK
.. D TPCK
PRT ;
U IO D HDR I $G(SDABRT)=1 Q
S (GTOTB,GTOTP,FTOTB,FTOTP,TTOTB,TTOTP)=0
I SDSCDIV'="" S DFTOTB(SDSCDNM)=0,DFTOTP(SDSCDNM)=0,DTTOTB(SDSCDNM)=0,DTTOTP(SDSCDNM)=0
S SDOE=""
F S SDOE=$O(^TMP($J,"SDSCBILL","COPAY",SDOE)) Q:SDOE="" D Q:$G(SDABRT)=1
. S BILN=""
. F S BILN=$O(^TMP($J,"SDSCBILL","COPAY",SDOE,BILN)) Q:BILN="" D Q:$G(SDABRT)=1
.. S SDBTR=^TMP($J,"SDSCBILL","COPAY",SDOE,BILN)
.. S TCHRG=$P(SDBTR,U,5)
.. S TPAY=$P(SDBTR,U,3)
.. S AUTHDT=$P(SDBTR,U,2)\1
.. S SDWHO=$$SVCC(SDOE)
.. S PYMDT=$P(SDBTR,U,4)
.. S SDSCD=$G(^SDSC(409.48,SDOE,0))
.. S ENCDT=$P(SDSCD,U,7)\1
.. S DFN=$P(SDSCD,U,11)
.. D DEM^VADPT S SDPAT=$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
.. S GTOTB=GTOTB+TCHRG,GTOTP=GTOTP+TPAY,FTOTB=FTOTB+TCHRG,FTOTP=FTOTP+TPAY
.. S DFTOTB(SDSCDNM)=$G(DFTOTB(SDSCDNM))+TCHRG,DFTOTP(SDSCDNM)=$G(DFTOTP(SDSCDNM))+TPAY
.. I L+3>IOSL D HDR Q:$G(SDABRT)=1
.. W !,SDOE,?10,SDPAT,?45,$$FMTE^XLFDT(ENCDT,"5Z")
.. W ?60,$$FMTE^XLFDT($P(SDWHO,"^",2),"5Z")
.. W ?75,$$FMTE^XLFDT(AUTHDT,"5Z"),?90,$$FMTE^XLFDT(PYMDT,"5Z")
.. W ?105,$J(TCHRG,10,2),?115,$J(TPAY,10,2)
.. S L=L+1
I $G(SDABRT)=1 Q
;
I L+6>IOSL D HDR I $G(SDABRT)=1 Q
W !,$TR($J(" ",IOM)," ","-"),!
W !,"TOTAL FIRST PARTY: ",?105,$J(FTOTB,10,2),?115,$J(FTOTP,10,2),!!
S L=L+5
; Print Third Party
S SDOE=""
F S SDOE=$O(^TMP($J,"SDSCBILL","THIRD",SDOE)) Q:SDOE="" D Q:$G(SDABRT)=1
. S BILN=""
. F S BILN=$O(^TMP($J,"SDSCBILL","THIRD",SDOE,BILN)) Q:BILN="" D Q:$G(SDABRT)=1
.. S SDBTR=^TMP($J,"SDSCBILL","THIRD",SDOE,BILN)
.. S TPAY=$P(SDBTR,U,3)
.. S AUTHDT=$P(SDBTR,U,2)\1
.. S SDWHO=$$SVCC(SDOE)
.. S PYMDT=$P(SDBTR,U,4)
.. S SDSCD=$G(^SDSC(409.48,SDOE,0))
.. S ENCDT=$P(SDSCD,U,7)\1
.. S DFN=$P(SDSCD,U,11)
.. D DEM^VADPT S SDPAT=$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
.. S TCHRG=$P(SDBTR,U)
.. S GTOTB=GTOTB+TCHRG,GTOTP=GTOTP+TPAY,TTOTB=TTOTB+TCHRG,TTOTP=TTOTP+TPAY
.. S DTTOTB(SDSCDNM)=$G(DTTOTB(SDSCDNM))+TCHRG,DTTOTP(SDSCDNM)=$G(DTTOTP(SDSCDNM))+TPAY
.. I L+3>IOSL D HDR Q:$G(SDABRT)=1
.. W !,SDOE,?10,SDPAT,?45,$$FMTE^XLFDT(ENCDT,"5Z")
.. W ?60,$$FMTE^XLFDT($P(SDWHO,"^",2),"5Z")
.. W ?75,$$FMTE^XLFDT(AUTHDT,"5Z"),?90,$$FMTE^XLFDT(PYMDT,"5Z")
.. W ?105,$J(TCHRG,10,2),?115,$J(TPAY,10,2)
.. S L=L+1
I $G(SDABRT)=1 Q
;
I L+6>IOSL D HDR I $G(SDABRT)=1 Q
W !,$TR($J(" ",IOM)," ","-"),!
W !,"TOTAL THIRD PARTY: ",?105,$J(TTOTB,10,2),?115,$J(TTOTP,10,2),!!
S L=L+5
I L+6>IOSL D HDR I $G(SDABRT)=1 Q
W !,$TR($J(" ",IOM)," ","-"),!
W !,"TOTAL FOR BOTH: ",?105,$J(GTOTB,10,2),?115,$J(GTOTP,10,2),!!
S L=L+5
Q
;
FPCK ;Check for First Party Bill
N SCBLNS,SCARTR
S SCBLNS=$$FPBILL^IBRSUTL(SDOE) I (SCBLNS="")!($P(SCBLNS,U))="" Q
S SCARTR=$$GETDATA^PRCAAPI($P(SCBLNS,U)) I SCARTR="" Q
S $P(SCARTR,U,5)=$P(SCBLNS,U,3)
S ^TMP($J,"SDSCBILL","COPAY",SDOE,$P(SCBLNS,U))=SCARTR
Q
;
TPCK ;Check for Third Party Bill
N SCBLNS,SCBID,SCARTR,SCI
S SCBLNS=$$TPBILL^IBRSUTL(SDOE) I SCBLNS="" Q
F SCI=1:1 S SCBID=$P(SCBLNS,U,SCI) Q:SCBID="" D
. S SCARTR=$$GETDATA^PRCAAPI(SCBID)
. I SCARTR="" Q
. S ^TMP($J,"SDSCBILL","THIRD",SDOE,SCBID)=SCARTR
Q
;
HDR ; Header
; Do not ask 'RETURN' before first page on CRT.
I $E(IOST,1,2)="C-",P D I 'Y S SDABRT=1 Q
.N DIR S DIR(0)="E" D ^DIR
; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
I $E(IOST,1,2)="C-"!P W @IOF
S P=P+1,L=4
W "Recovered Costs Report by Division: "_SDSCDNM_" ",?90,"Run Date: ",SDRUN,?124,"Page ",$J(P,3)
W !,"Enc #",?10,"Patient",?45,"Enc Date",?60,"Change Date",?75,"Auth Date",?90,"Pay Date",?105,"Prncpl Bill",?117,"Prncpl Pay"
W !,$TR($J(" ",IOM)," ","-"),!
Q
;
EXT ;
N L,TOTALB,TOTALP,DIV
I CT>1,$G(SDABRT)'=1 D
. I $E(IOST,1,2)="C-",P N DIR S DIR(0)="E" D ^DIR I 'Y S SDABRT=1 Q
. ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
. I $E(IOST,1,2)="C-"!P W @IOF
. S P=P+1,L=4,TOTALB=0,TOTALP=0
. I $E(THDR,$L(THDR))="," S THDR=$E(THDR,1,$L(THDR)-1)
. W "Recovered Costs Report",?90,"Run Date: ",SDRUN,?124,"Page ",$J(P,3)
. W !,"By Division(s) "_THDR
. W !,?105,"Prncpl Bill",?117,"Prncpl Pay"
. W !,$TR($J(" ",IOM)," ","-"),!
. W !,?10,"FIRST PARTY TOTAL"
. S DIV="" F S DIV=$O(DFTOTB(DIV)) Q:DIV="" D
.. W !,?30,DIV,?105,$J(DFTOTB(DIV),10,2),?115,$J(DFTOTP(DIV),10,2)
.. S TOTALB=TOTALB+DFTOTB(DIV),TOTALP=TOTALP+DFTOTP(DIV)
. W !,$TR($J(" ",IOM)," ","-"),!
. W !,?10,"THIRD PARTY TOTAL"
. S DIV="" F S DIV=$O(DTTOTB(DIV)) Q:DIV="" D
.. W !,?30,DIV,?105,$J(DTTOTB(DIV),10,2),?115,$J(DTTOTP(DIV),10,2)
.. S TOTALB=TOTALB+DTTOTB(DIV),TOTALP=TOTALP+DTTOTP(DIV)
. W !,$TR($J(" ",IOM)," ","-"),!
. W !,?10,"TOTAL FOR BOTH FIRST AND THIRD PARTY",?105,$J(TOTALB,10,2),?115,$J(TOTALP,10,2)
D RPTEND^SDSCRPT1
;
EXIT ; Exit tag
K SDQFL,SDRUN,SDEDT,SDOE,SDOEDT,SDSCTDT,SDSCBDT,SDSCEDT,POP,SDABRT,BILL
K BILT,FIND,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,SCLN D KVA^VADPT
K ^TMP($J,"SDSCBILL")
Q
;
SVCC(SDENC) ; Service Connected Last Edit Change
;
; Input:
; SDENC = Encounter IEN
;
; Output:
; Function = "" - (null if undefined)
; = EDITED BY_"^"_DATE EDITED - (WHO^WHEN)
;
N SDJ,SDVAL,SDX
S SDVAL="",SDJ=999999
S SDJ=$O(^SDSC(409.48,SDENC,1,SDJ),-1)
I SDJ D
. S SDX=$G(^SDSC(409.48,SDENC,1,SDJ,0))
. I $P(SDX,U,5)=0 D
. . S SDVAL=$P(SDX,U,3)_"^"_$P(SDX,U,2)
Q SDVAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCRP2 7625 printed Sep 23, 2025@20:38:09 Page 2
SDSCRP2 ;ALB/JAM/RBS - Recovered Costs Report for ASCD ; 3/13/07 2:50pm
+1 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
+2 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
+3 ;;known as Service Connected Automated Monitoring (SCAM).
+4 ;
+5 ;**Program Description**
+6 ; This program will report on all bills generated and amounts
+7 ; received for encounters whose Service Connected was changed
+8 ; from 'Yes' to 'No'.
+9 QUIT
EN ; Entry point - find all records
+1 ; Get Division
+2 NEW SDSCDVSL,SDSCDVLN,SDRUN,ZTDESC,ZTRTN,ZTIO,ZTSAVE,DIR,X,Y
+3 DO DIV^SDSCUTL
+4 DO ^DIR
+5 IF $GET(DTOUT)!($GET(DUOUT))
GOTO EXIT
+6 SET SDSCDVSL=Y
SET SDSCDVLN=SCLN
KILL DIR,Y,X,SCLN
+7 SET SDRUN=$$HTE^XLFDT($HOROLOG,1)
SET ZTDESC="RECOVERED COSTS REPORT"
SET ZTRTN="BEG^SDSCRP2"
+8 ; Get start and end date for report.
+9 DO GETDATE^SDSCOMP
IF SDSCTDT=""
GOTO EXIT
+10 WRITE !!,"You will need a 132 column printer for this report!",!
+11 KILL %ZIS
SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+12 IF '$DATA(IO("Q"))
KILL ZTDESC
GOTO @ZTRTN
+13 SET ZTIO=ION
SET ZTSAVE("*")=""
+14 DO ^%ZTLOAD
+15 GOTO EXIT
+16 ;
BEG ; Begin report
+1 NEW P,L,SDABRT,CT,SDSCDIV,SDSCDNM,THDR,SDI,DFTOTB,DFTOTP,DTTOTB,DTTOTP
+2 SET (P,L,SDABRT,CT)=0
+3 SET SDSCDIV=$SELECT(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
+4 IF SDSCDIV=""
SET SDSCDNM="ALL"
DO FND
GOTO EXT
+5 IF SDSCDIV'=""
Begin DoDot:1
+6 SET THDR=""
+7 FOR SDI=1:1:$LENGTH(SDSCDVSL,",")
SET SDSCDIV=$PIECE(SDSCDVSL,",",SDI)
if SDSCDIV=""
QUIT
Begin DoDot:2
+8 SET SDSCDNM=$PIECE(^DG(40.8,SDSCDIV,0),"^",1)
SET THDR=THDR_SDSCDNM_","
SET CT=CT+1
DO FND
End DoDot:2
if $GET(SDABRT)=1
QUIT
End DoDot:1
+9 GOTO EXT
+10 ;
FND ; Find records
+1 NEW SDATA,SDOEDT,SDOE,DFN,ENCDT,SDCLM,GTOTB,GTOTP,FTOTB,FTOTP,TTOTB,TTOTP
+2 NEW BILN,TCHRG,TPAY,AUTHDT,SDWHO,PYMDT,ENCDT,SDSCD,SDPAT,VADM,SCVAL,SDBTR
+3 KILL ^TMP($JOB,"SDSCBILL")
+4 SET SDOEDT=SDSCTDT
+5 FOR
SET SDOEDT=$ORDER(^SDSC(409.48,"C","C",SDOEDT))
if SDOEDT=""!(SDOEDT\1>SDEDT)
QUIT
Begin DoDot:1
+6 SET SDOE=0
+7 FOR
SET SDOE=$ORDER(^SDSC(409.48,"C","C",SDOEDT,SDOE))
if 'SDOE
QUIT
Begin DoDot:2
+8 SET SDATA=$GET(^SDSC(409.48,SDOE,0))
IF SDATA=""
QUIT
+9 IF $PIECE(SDATA,U,5)'="C"
QUIT
+10 IF SDSCDIV'=""
if $PIECE(SDATA,U,12)'=SDSCDIV
QUIT
+11 IF '+$$GETOE^SDOE(SDOE)
QUIT
+12 ;find only encounters that were changed by ASCD from SC to NSC
+13 SET SCVAL=$$SCHNG^SDSCUTL(SDOE)
IF '+SCVAL
QUIT
+14 IF $PIECE(SCVAL,U,3)
QUIT
+15 DO FPCK
+16 DO TPCK
End DoDot:2
End DoDot:1
PRT ;
+1 USE IO
DO HDR
IF $GET(SDABRT)=1
QUIT
+2 SET (GTOTB,GTOTP,FTOTB,FTOTP,TTOTB,TTOTP)=0
+3 IF SDSCDIV'=""
SET DFTOTB(SDSCDNM)=0
SET DFTOTP(SDSCDNM)=0
SET DTTOTB(SDSCDNM)=0
SET DTTOTP(SDSCDNM)=0
+4 SET SDOE=""
+5 FOR
SET SDOE=$ORDER(^TMP($JOB,"SDSCBILL","COPAY",SDOE))
if SDOE=""
QUIT
Begin DoDot:1
+6 SET BILN=""
+7 FOR
SET BILN=$ORDER(^TMP($JOB,"SDSCBILL","COPAY",SDOE,BILN))
if BILN=""
QUIT
Begin DoDot:2
+8 SET SDBTR=^TMP($JOB,"SDSCBILL","COPAY",SDOE,BILN)
+9 SET TCHRG=$PIECE(SDBTR,U,5)
+10 SET TPAY=$PIECE(SDBTR,U,3)
+11 SET AUTHDT=$PIECE(SDBTR,U,2)\1
+12 SET SDWHO=$$SVCC(SDOE)
+13 SET PYMDT=$PIECE(SDBTR,U,4)
+14 SET SDSCD=$GET(^SDSC(409.48,SDOE,0))
+15 SET ENCDT=$PIECE(SDSCD,U,7)\1
+16 SET DFN=$PIECE(SDSCD,U,11)
+17 DO DEM^VADPT
SET SDPAT=$EXTRACT(VADM(1),1,25)_" ("_$EXTRACT($PIECE(VADM(2),U),6,9)_")"
+18 SET GTOTB=GTOTB+TCHRG
SET GTOTP=GTOTP+TPAY
SET FTOTB=FTOTB+TCHRG
SET FTOTP=FTOTP+TPAY
+19 SET DFTOTB(SDSCDNM)=$GET(DFTOTB(SDSCDNM))+TCHRG
SET DFTOTP(SDSCDNM)=$GET(DFTOTP(SDSCDNM))+TPAY
+20 IF L+3>IOSL
DO HDR
if $GET(SDABRT)=1
QUIT
+21 WRITE !,SDOE,?10,SDPAT,?45,$$FMTE^XLFDT(ENCDT,"5Z")
+22 WRITE ?60,$$FMTE^XLFDT($PIECE(SDWHO,"^",2),"5Z")
+23 WRITE ?75,$$FMTE^XLFDT(AUTHDT,"5Z"),?90,$$FMTE^XLFDT(PYMDT,"5Z")
+24 WRITE ?105,$JUSTIFY(TCHRG,10,2),?115,$JUSTIFY(TPAY,10,2)
+25 SET L=L+1
End DoDot:2
if $GET(SDABRT)=1
QUIT
End DoDot:1
if $GET(SDABRT)=1
QUIT
+26 IF $GET(SDABRT)=1
QUIT
+27 ;
+28 IF L+6>IOSL
DO HDR
IF $GET(SDABRT)=1
QUIT
+29 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+30 WRITE !,"TOTAL FIRST PARTY: ",?105,$JUSTIFY(FTOTB,10,2),?115,$JUSTIFY(FTOTP,10,2),!!
+31 SET L=L+5
+32 ; Print Third Party
+33 SET SDOE=""
+34 FOR
SET SDOE=$ORDER(^TMP($JOB,"SDSCBILL","THIRD",SDOE))
if SDOE=""
QUIT
Begin DoDot:1
+35 SET BILN=""
+36 FOR
SET BILN=$ORDER(^TMP($JOB,"SDSCBILL","THIRD",SDOE,BILN))
if BILN=""
QUIT
Begin DoDot:2
+37 SET SDBTR=^TMP($JOB,"SDSCBILL","THIRD",SDOE,BILN)
+38 SET TPAY=$PIECE(SDBTR,U,3)
+39 SET AUTHDT=$PIECE(SDBTR,U,2)\1
+40 SET SDWHO=$$SVCC(SDOE)
+41 SET PYMDT=$PIECE(SDBTR,U,4)
+42 SET SDSCD=$GET(^SDSC(409.48,SDOE,0))
+43 SET ENCDT=$PIECE(SDSCD,U,7)\1
+44 SET DFN=$PIECE(SDSCD,U,11)
+45 DO DEM^VADPT
SET SDPAT=$EXTRACT(VADM(1),1,25)_" ("_$EXTRACT($PIECE(VADM(2),U),6,9)_")"
+46 SET TCHRG=$PIECE(SDBTR,U)
+47 SET GTOTB=GTOTB+TCHRG
SET GTOTP=GTOTP+TPAY
SET TTOTB=TTOTB+TCHRG
SET TTOTP=TTOTP+TPAY
+48 SET DTTOTB(SDSCDNM)=$GET(DTTOTB(SDSCDNM))+TCHRG
SET DTTOTP(SDSCDNM)=$GET(DTTOTP(SDSCDNM))+TPAY
+49 IF L+3>IOSL
DO HDR
if $GET(SDABRT)=1
QUIT
+50 WRITE !,SDOE,?10,SDPAT,?45,$$FMTE^XLFDT(ENCDT,"5Z")
+51 WRITE ?60,$$FMTE^XLFDT($PIECE(SDWHO,"^",2),"5Z")
+52 WRITE ?75,$$FMTE^XLFDT(AUTHDT,"5Z"),?90,$$FMTE^XLFDT(PYMDT,"5Z")
+53 WRITE ?105,$JUSTIFY(TCHRG,10,2),?115,$JUSTIFY(TPAY,10,2)
+54 SET L=L+1
End DoDot:2
if $GET(SDABRT)=1
QUIT
End DoDot:1
if $GET(SDABRT)=1
QUIT
+55 IF $GET(SDABRT)=1
QUIT
+56 ;
+57 IF L+6>IOSL
DO HDR
IF $GET(SDABRT)=1
QUIT
+58 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+59 WRITE !,"TOTAL THIRD PARTY: ",?105,$JUSTIFY(TTOTB,10,2),?115,$JUSTIFY(TTOTP,10,2),!!
+60 SET L=L+5
+61 IF L+6>IOSL
DO HDR
IF $GET(SDABRT)=1
QUIT
+62 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+63 WRITE !,"TOTAL FOR BOTH: ",?105,$JUSTIFY(GTOTB,10,2),?115,$JUSTIFY(GTOTP,10,2),!!
+64 SET L=L+5
+65 QUIT
+66 ;
FPCK ;Check for First Party Bill
+1 NEW SCBLNS,SCARTR
+2 SET SCBLNS=$$FPBILL^IBRSUTL(SDOE)
IF (SCBLNS="")!($PIECE(SCBLNS,U))=""
QUIT
+3 SET SCARTR=$$GETDATA^PRCAAPI($PIECE(SCBLNS,U))
IF SCARTR=""
QUIT
+4 SET $PIECE(SCARTR,U,5)=$PIECE(SCBLNS,U,3)
+5 SET ^TMP($JOB,"SDSCBILL","COPAY",SDOE,$PIECE(SCBLNS,U))=SCARTR
+6 QUIT
+7 ;
TPCK ;Check for Third Party Bill
+1 NEW SCBLNS,SCBID,SCARTR,SCI
+2 SET SCBLNS=$$TPBILL^IBRSUTL(SDOE)
IF SCBLNS=""
QUIT
+3 FOR SCI=1:1
SET SCBID=$PIECE(SCBLNS,U,SCI)
if SCBID=""
QUIT
Begin DoDot:1
+4 SET SCARTR=$$GETDATA^PRCAAPI(SCBID)
+5 IF SCARTR=""
QUIT
+6 SET ^TMP($JOB,"SDSCBILL","THIRD",SDOE,SCBID)=SCARTR
End DoDot:1
+7 QUIT
+8 ;
HDR ; Header
+1 ; Do not ask 'RETURN' before first page on CRT.
+2 IF $EXTRACT(IOST,1,2)="C-"
IF P
Begin DoDot:1
+3 NEW DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
IF 'Y
SET SDABRT=1
QUIT
+4 ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
+5 IF $EXTRACT(IOST,1,2)="C-"!P
WRITE @IOF
+6 SET P=P+1
SET L=4
+7 WRITE "Recovered Costs Report by Division: "_SDSCDNM_" ",?90,"Run Date: ",SDRUN,?124,"Page ",$JUSTIFY(P,3)
+8 WRITE !,"Enc #",?10,"Patient",?45,"Enc Date",?60,"Change Date",?75,"Auth Date",?90,"Pay Date",?105,"Prncpl Bill",?117,"Prncpl Pay"
+9 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+10 QUIT
+11 ;
EXT ;
+1 NEW L,TOTALB,TOTALP,DIV
+2 IF CT>1
IF $GET(SDABRT)'=1
Begin DoDot:1
+3 IF $EXTRACT(IOST,1,2)="C-"
IF P
NEW DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET SDABRT=1
QUIT
+4 ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
+5 IF $EXTRACT(IOST,1,2)="C-"!P
WRITE @IOF
+6 SET P=P+1
SET L=4
SET TOTALB=0
SET TOTALP=0
+7 IF $EXTRACT(THDR,$LENGTH(THDR))=","
SET THDR=$EXTRACT(THDR,1,$LENGTH(THDR)-1)
+8 WRITE "Recovered Costs Report",?90,"Run Date: ",SDRUN,?124,"Page ",$JUSTIFY(P,3)
+9 WRITE !,"By Division(s) "_THDR
+10 WRITE !,?105,"Prncpl Bill",?117,"Prncpl Pay"
+11 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+12 WRITE !,?10,"FIRST PARTY TOTAL"
+13 SET DIV=""
FOR
SET DIV=$ORDER(DFTOTB(DIV))
if DIV=""
QUIT
Begin DoDot:2
+14 WRITE !,?30,DIV,?105,$JUSTIFY(DFTOTB(DIV),10,2),?115,$JUSTIFY(DFTOTP(DIV),10,2)
+15 SET TOTALB=TOTALB+DFTOTB(DIV)
SET TOTALP=TOTALP+DFTOTP(DIV)
End DoDot:2
+16 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+17 WRITE !,?10,"THIRD PARTY TOTAL"
+18 SET DIV=""
FOR
SET DIV=$ORDER(DTTOTB(DIV))
if DIV=""
QUIT
Begin DoDot:2
+19 WRITE !,?30,DIV,?105,$JUSTIFY(DTTOTB(DIV),10,2),?115,$JUSTIFY(DTTOTP(DIV),10,2)
+20 SET TOTALB=TOTALB+DTTOTB(DIV)
SET TOTALP=TOTALP+DTTOTP(DIV)
End DoDot:2
+21 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+22 WRITE !,?10,"TOTAL FOR BOTH FIRST AND THIRD PARTY",?105,$JUSTIFY(TOTALB,10,2),?115,$JUSTIFY(TOTALP,10,2)
End DoDot:1
+23 DO RPTEND^SDSCRPT1
+24 ;
EXIT ; Exit tag
+1 KILL SDQFL,SDRUN,SDEDT,SDOE,SDOEDT,SDSCTDT,SDSCBDT,SDSCEDT,POP,SDABRT,BILL
+2 KILL BILT,FIND,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,SCLN
DO KVA^VADPT
+3 KILL ^TMP($JOB,"SDSCBILL")
+4 QUIT
+5 ;
SVCC(SDENC) ; Service Connected Last Edit Change
+1 ;
+2 ; Input:
+3 ; SDENC = Encounter IEN
+4 ;
+5 ; Output:
+6 ; Function = "" - (null if undefined)
+7 ; = EDITED BY_"^"_DATE EDITED - (WHO^WHEN)
+8 ;
+9 NEW SDJ,SDVAL,SDX
+10 SET SDVAL=""
SET SDJ=999999
+11 SET SDJ=$ORDER(^SDSC(409.48,SDENC,1,SDJ),-1)
+12 IF SDJ
Begin DoDot:1
+13 SET SDX=$GET(^SDSC(409.48,SDENC,1,SDJ,0))
+14 IF $PIECE(SDX,U,5)=0
Begin DoDot:2
+15 SET SDVAL=$PIECE(SDX,U,3)_"^"_$PIECE(SDX,U,2)
End DoDot:2
End DoDot:1
+16 QUIT SDVAL
