SDSCRP1 ;ALB/JAM/RBS - Unbilled Amt Report for ASCD ; 3/6/07 10:45am
;;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 report shall be used by billing clerks and the MCCR
; Coordinator or other Billing Supervisor
Q
START ;SC Unbilled Amount Report
N SDOPT,SCOPT,SDSCCR,SDSCTAT,SDTYPE,SDSUPER,DIR,DIRUT,Y
W !,"Service Connected Unbilled Amount Report"
S DIR(0)="SO^R:Regular;S:Supervisor",DIR("B")="R",SDSUPER=0
S DIR("A")="Which option do you want to run?"
D ^DIR I $D(DIRUT) Q
I Y="S" D I 'SDSUPER Q
.;Determine type of user
.D TYPE^SDSCUTL
.I $G(SDTYPE)'="S" D EN^DDIOL("You do not have privileges to run this report.") Q
.S SDSUPER=1
D SCSEL I $G(SDABRT) K SDABRT Q
D RPT
Q
;
SCSEL ;Service connection selection
N DIR,DIRUT,X,Y
W !!,"Encounter to Report"
S DIR(0)="SO^S:SC to NSC;N:NSC to SC"
S DIR("B")="S",DIR("A")="Which option do you want to run?"
D ^DIR I $D(DIRUT) S SDABRT=1 Q
S SCOPT=$S(Y="S":2,1:1)
Q
RPT ; Build the report
N DIR,SDSCDVSL,SDSCDVLN,SDRUN,SDSCTDT,ZTIO,ZTSAVE,%ZIS,ZTDESC,ZTRTN
; Get Divisions
D DIV^SDSCUTL
D ^DIR
I $G(DTOUT)!($G(DUOUT)) G END
S SDSCDVSL=Y,SDSCDVLN=SCLN
K X,Y
;
S SDRUN=$$HTE^XLFDT($H,1)
; Get start and end date for report.
D GETDATE^SDSCOMP I SDSCTDT="" G END
;
W !!,"You will need a 132 column printer for this report!",!
S ZTDESC="BILLED/UNBILLED AMOUNT REPORT",ZTRTN="BEG^SDSCRP1"
S %ZIS="QM" D ^%ZIS G END:POP
I '$D(IO("Q")) K ZTDESC G @ZTRTN
S ZTIO=ION,ZTSAVE("*")=""
D ^%ZTLOAD
G END
;
BEG ; Begin report
N P,L,SDABRT,CT,SDSCDIV,SDSCDNM,AI,THDR,CT,DITOT,DPTOT
S (P,L,SDABRT,CT)=0
S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
I SDSCDIV="" S SDSCDNM="ALL" D PRT G EXT
I SDSCDIV'="" D
. S THDR=""
. F AI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",AI) Q:SDSCDIV="" D Q:$G(SDABRT)=1
.. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1
.. S DITOT(SDSCDNM)=0,DPTOT(SDSCDNM)=0
.. D PRT
G EXT
;
PRT ; Print
N SDOEDT,ITOTAL,PTOTAL,SDOE,DFN,VADM,SDIBAMT,SSN,SDINST,SDPROF,SCVAL
U IO D HDR I $G(SDABRT)=1 Q
S SDOEDT=SDSCTDT,ITOTAL=0,PTOTAL=0
F S SDOEDT=$O(^SDSC(409.48,"C","C",SDOEDT)) Q:SDOEDT=""!(SDOEDT\1>SDEDT) D Q:$G(SDABRT)=1
. S SDOE=""
. F S SDOE=$O(^SDSC(409.48,"C","C",SDOEDT,SDOE)) Q:SDOE="" D Q:$G(SDABRT)=1
.. I SDSCDIV'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
.. ;if encounter was not changed quit
.. S SCVAL=$$SCHNG^SDSCUTL(SDOE) I '+SCVAL Q
.. I '$S(($P(SCVAL,U,3))&(SCOPT=1):1,($P(SCVAL,U,2))&(SCOPT=2):1,1:0) Q
.. ;Call Billing API
.. S SDIBAMT=$$TPCHG^IBRSUTL(SDOE) I SDIBAMT="" Q
.. S SDPROF=$P(SDIBAMT,U,2),SDINST=$P(SDIBAMT,U)
.. I SDPROF=0,SDINST=0 Q
.. S SDBILL=$$TPBILL^IBRSUTL(SDOE),SDBILL=$TR(SDBILL,"^","/")
.. S ITOTAL=ITOTAL+SDINST,PTOTAL=PTOTAL+SDPROF
.. I SDSCDNM'="" S DITOT(SDSCDNM)=$G(DITOT(SDSCDNM))+SDINST,DPTOT(SDSCDNM)=$G(DPTOT(SDSCDNM))+SDPROF
.. I L+4>IOSL D HDR Q:$G(SDABRT)=1
.. S DFN=$$GET1^DIQ(409.48,SDOE_",",.11,"I") I DFN="" Q
.. D DEM^VADPT
.. W !,$E(VADM(1),1,20)
.. S SSN=$P(VADM(2),U)
.. S SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10)
.. W ?22,SSN
.. W ?35,$E($$FMTE^XLFDT(SDOEDT,"5Z"),1,16),?55,SDOE
.. W !,?5,$E($$GET1^DIQ(409.68,SDOE_",",.04,"E"),1,20)
.. W ?27,$E($$GET1^DIQ(409.48,SDOE_",",.08,"E"),1,20)
.. S SDLEDT=$$GET1^DIQ(409.48,SDOE_",",.02,"I")
.. W ?49,$E($$FMTE^XLFDT(SDLEDT,"5Z"),1,16)
.. W ?65,$J(SDINST,0,2)
.. W ?75,$J(SDPROF,0,2)
.. W ?85,$E(SDBILL,1,$L(SDBILL)-1)
.. ;
.. I SDSUPER D PER W ?110,$E(SDNAME,1,$L(SDNAME)-1)
.. S L=L+2
I $G(SDABRT)=1 Q
;
I L+3>IOSL D HDR I $G(SDABRT)=1 Q
W !,$TR($J(" ",IOM)," ","-")
W !,"TOTAL:",?65,$J(ITOTAL,0,2),?75,$J(PTOTAL,0,2)
S L=L+2
Q
;
PER ; Last 2 Persons who edited record
N SDI,SDLI
S SDLI="A",SDNAME=""
F SDI=1:1:2 S SDLI=$O(^SDSC(409.48,SDOE,1,SDLI),-1) Q:'SDLI D
. S APER=$$GET1^DIQ(409.481,SDLI_","_SDOE_",",.03,"E")
. S SDNAME=SDNAME_APER_"/"
. Q
Q
;
HDR ; Header
; Do not ask 'RETURN' before first page on CRT.
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=5
W "ASCD "_$S(SCOPT=2:"Unbilled (SC to NSC)",1:"Billable (NSC to SC)")_" Amounts Report by Division "_SDSCDNM_" ",?90,"Run Date: ",SDRUN,?124,"Page ",$J(P,3)
W !,"*** Report reflects ONLY reviewed encounters ***"
W !!,"Name",?22,"SSN",?35,"Enc Date/Time",?55,"Encounter No."
W !,?5,"Clinic",?27,"Prim Prov",?49,"Date Edited",?65,"Instit $",?75,"Profess $",?85,"Bill Nos."
I SDSUPER W ?110,"Editors"
W !,$TR($J(" ",IOM)," ","-"),!
Q
;
EXT ;
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
. I $E(THDR,$L(THDR))="," S THDR=$E(THDR,1,$L(THDR)-1)
. W $S(SCOPT=2:"Unbilled (SC to NSC)",1:"Billable (NSC to SC)")_" Amounts Report",?90,"Run Date: ",SDRUN,?124,"Page ",$J(P,3)
. W !,"*** Report reflects ONLY reviewed encounters ***"
. W !!,"By Division(s) "_THDR
. W !,?65,"Instit $",?75,"Profess $"
. W !,$TR($J(" ",IOM)," ","-"),!
. S DIV="" F S DIV=$O(DITOT(DIV)) Q:DIV="" D
.. W !,?20,DIV,?65,$J(DITOT(DIV),0,2),?75,$J(DPTOT(DIV),0,2)
.. S TOTAI=TOTAI+DITOT(DIV),TOTAP=TOTAP+DPTOT(DIV)
.. Q
. W !,$TR($J(" ",IOM)," ","-"),!
. W !,?20,"TOTAL",?65,$J(TOTAI,0,2),?75,$J(TOTAP,0,2)
. Q
D RPTEND^SDSCRPT1
;
END ; Exit tag
K SDBILL,SDLI,SDNAME,APER,SDSUPER,DIV,POP,P,L,SDABRT,DFN,TOTAI,TOTAP
K SDLEDT,SDRUN,SDEDT,SDOE,SDOEDT,SDSCTDT,SDSCBDT,SDSCEDT
K DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,SCLN D KVA^VADPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCRP1 5969 printed Nov 22, 2024@18:11:10 Page 2
SDSCRP1 ;ALB/JAM/RBS - Unbilled Amt Report for ASCD ; 3/6/07 10:45am
+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 report shall be used by billing clerks and the MCCR
+7 ; Coordinator or other Billing Supervisor
+8 QUIT
START ;SC Unbilled Amount Report
+1 NEW SDOPT,SCOPT,SDSCCR,SDSCTAT,SDTYPE,SDSUPER,DIR,DIRUT,Y
+2 WRITE !,"Service Connected Unbilled Amount Report"
+3 SET DIR(0)="SO^R:Regular;S:Supervisor"
SET DIR("B")="R"
SET SDSUPER=0
+4 SET DIR("A")="Which option do you want to run?"
+5 DO ^DIR
IF $DATA(DIRUT)
QUIT
+6 IF Y="S"
Begin DoDot:1
+7 ;Determine type of user
+8 DO TYPE^SDSCUTL
+9 IF $GET(SDTYPE)'="S"
DO EN^DDIOL("You do not have privileges to run this report.")
QUIT
+10 SET SDSUPER=1
End DoDot:1
IF 'SDSUPER
QUIT
+11 DO SCSEL
IF $GET(SDABRT)
KILL SDABRT
QUIT
+12 DO RPT
+13 QUIT
+14 ;
SCSEL ;Service connection selection
+1 NEW DIR,DIRUT,X,Y
+2 WRITE !!,"Encounter to Report"
+3 SET DIR(0)="SO^S:SC to NSC;N:NSC to SC"
+4 SET DIR("B")="S"
SET DIR("A")="Which option do you want to run?"
+5 DO ^DIR
IF $DATA(DIRUT)
SET SDABRT=1
QUIT
+6 SET SCOPT=$SELECT(Y="S":2,1:1)
+7 QUIT
RPT ; Build the report
+1 NEW DIR,SDSCDVSL,SDSCDVLN,SDRUN,SDSCTDT,ZTIO,ZTSAVE,%ZIS,ZTDESC,ZTRTN
+2 ; Get Divisions
+3 DO DIV^SDSCUTL
+4 DO ^DIR
+5 IF $GET(DTOUT)!($GET(DUOUT))
GOTO END
+6 SET SDSCDVSL=Y
SET SDSCDVLN=SCLN
+7 KILL X,Y
+8 ;
+9 SET SDRUN=$$HTE^XLFDT($HOROLOG,1)
+10 ; Get start and end date for report.
+11 DO GETDATE^SDSCOMP
IF SDSCTDT=""
GOTO END
+12 ;
+13 WRITE !!,"You will need a 132 column printer for this report!",!
+14 SET ZTDESC="BILLED/UNBILLED AMOUNT REPORT"
SET ZTRTN="BEG^SDSCRP1"
+15 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO END
+16 IF '$DATA(IO("Q"))
KILL ZTDESC
GOTO @ZTRTN
+17 SET ZTIO=ION
SET ZTSAVE("*")=""
+18 DO ^%ZTLOAD
+19 GOTO END
+20 ;
BEG ; Begin report
+1 NEW P,L,SDABRT,CT,SDSCDIV,SDSCDNM,AI,THDR,CT,DITOT,DPTOT
+2 SET (P,L,SDABRT,CT)=0
+3 SET SDSCDIV=$SELECT(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
+4 IF SDSCDIV=""
SET SDSCDNM="ALL"
DO PRT
GOTO EXT
+5 IF SDSCDIV'=""
Begin DoDot:1
+6 SET THDR=""
+7 FOR AI=1:1:$LENGTH(SDSCDVSL,",")
SET SDSCDIV=$PIECE(SDSCDVSL,",",AI)
if SDSCDIV=""
QUIT
Begin DoDot:2
+8 SET SDSCDNM=$PIECE(^DG(40.8,SDSCDIV,0),"^",1)
SET THDR=THDR_SDSCDNM_","
SET CT=CT+1
+9 SET DITOT(SDSCDNM)=0
SET DPTOT(SDSCDNM)=0
+10 DO PRT
End DoDot:2
if $GET(SDABRT)=1
QUIT
End DoDot:1
+11 GOTO EXT
+12 ;
PRT ; Print
+1 NEW SDOEDT,ITOTAL,PTOTAL,SDOE,DFN,VADM,SDIBAMT,SSN,SDINST,SDPROF,SCVAL
+2 USE IO
DO HDR
IF $GET(SDABRT)=1
QUIT
+3 SET SDOEDT=SDSCTDT
SET ITOTAL=0
SET PTOTAL=0
+4 FOR
SET SDOEDT=$ORDER(^SDSC(409.48,"C","C",SDOEDT))
if SDOEDT=""!(SDOEDT\1>SDEDT)
QUIT
Begin DoDot:1
+5 SET SDOE=""
+6 FOR
SET SDOE=$ORDER(^SDSC(409.48,"C","C",SDOEDT,SDOE))
if SDOE=""
QUIT
Begin DoDot:2
+7 IF SDSCDIV'=""
if $PIECE(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
QUIT
+8 ;if encounter was not changed quit
+9 SET SCVAL=$$SCHNG^SDSCUTL(SDOE)
IF '+SCVAL
QUIT
+10 IF '$SELECT(($PIECE(SCVAL,U,3))&(SCOPT=1):1,($PIECE(SCVAL,U,2))&(SCOPT=2):1,1:0)
QUIT
+11 ;Call Billing API
+12 SET SDIBAMT=$$TPCHG^IBRSUTL(SDOE)
IF SDIBAMT=""
QUIT
+13 SET SDPROF=$PIECE(SDIBAMT,U,2)
SET SDINST=$PIECE(SDIBAMT,U)
+14 IF SDPROF=0
IF SDINST=0
QUIT
+15 SET SDBILL=$$TPBILL^IBRSUTL(SDOE)
SET SDBILL=$TRANSLATE(SDBILL,"^","/")
+16 SET ITOTAL=ITOTAL+SDINST
SET PTOTAL=PTOTAL+SDPROF
+17 IF SDSCDNM'=""
SET DITOT(SDSCDNM)=$GET(DITOT(SDSCDNM))+SDINST
SET DPTOT(SDSCDNM)=$GET(DPTOT(SDSCDNM))+SDPROF
+18 IF L+4>IOSL
DO HDR
if $GET(SDABRT)=1
QUIT
+19 SET DFN=$$GET1^DIQ(409.48,SDOE_",",.11,"I")
IF DFN=""
QUIT
+20 DO DEM^VADPT
+21 WRITE !,$EXTRACT(VADM(1),1,20)
+22 SET SSN=$PIECE(VADM(2),U)
+23 SET SSN=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,10)
+24 WRITE ?22,SSN
+25 WRITE ?35,$EXTRACT($$FMTE^XLFDT(SDOEDT,"5Z"),1,16),?55,SDOE
+26 WRITE !,?5,$EXTRACT($$GET1^DIQ(409.68,SDOE_",",.04,"E"),1,20)
+27 WRITE ?27,$EXTRACT($$GET1^DIQ(409.48,SDOE_",",.08,"E"),1,20)
+28 SET SDLEDT=$$GET1^DIQ(409.48,SDOE_",",.02,"I")
+29 WRITE ?49,$EXTRACT($$FMTE^XLFDT(SDLEDT,"5Z"),1,16)
+30 WRITE ?65,$JUSTIFY(SDINST,0,2)
+31 WRITE ?75,$JUSTIFY(SDPROF,0,2)
+32 WRITE ?85,$EXTRACT(SDBILL,1,$LENGTH(SDBILL)-1)
+33 ;
+34 IF SDSUPER
DO PER
WRITE ?110,$EXTRACT(SDNAME,1,$LENGTH(SDNAME)-1)
+35 SET L=L+2
End DoDot:2
if $GET(SDABRT)=1
QUIT
End DoDot:1
if $GET(SDABRT)=1
QUIT
+36 IF $GET(SDABRT)=1
QUIT
+37 ;
+38 IF L+3>IOSL
DO HDR
IF $GET(SDABRT)=1
QUIT
+39 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+40 WRITE !,"TOTAL:",?65,$JUSTIFY(ITOTAL,0,2),?75,$JUSTIFY(PTOTAL,0,2)
+41 SET L=L+2
+42 QUIT
+43 ;
PER ; Last 2 Persons who edited record
+1 NEW SDI,SDLI
+2 SET SDLI="A"
SET SDNAME=""
+3 FOR SDI=1:1:2
SET SDLI=$ORDER(^SDSC(409.48,SDOE,1,SDLI),-1)
if 'SDLI
QUIT
Begin DoDot:1
+4 SET APER=$$GET1^DIQ(409.481,SDLI_","_SDOE_",",.03,"E")
+5 SET SDNAME=SDNAME_APER_"/"
+6 QUIT
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
NEW DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET SDABRT=1
QUIT
+3 ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
+4 IF $EXTRACT(IOST,1,2)="C-"!P
WRITE @IOF
+5 SET P=P+1
SET L=5
+6 WRITE "ASCD "_$SELECT(SCOPT=2:"Unbilled (SC to NSC)",1:"Billable (NSC to SC)")_" Amounts Report by Division "_SDSCDNM_" ",?90,"Run Date: ",SDRUN,?124,"Page ",$JUSTIFY(P,3)
+7 WRITE !,"*** Report reflects ONLY reviewed encounters ***"
+8 WRITE !!,"Name",?22,"SSN",?35,"Enc Date/Time",?55,"Encounter No."
+9 WRITE !,?5,"Clinic",?27,"Prim Prov",?49,"Date Edited",?65,"Instit $",?75,"Profess $",?85,"Bill Nos."
+10 IF SDSUPER
WRITE ?110,"Editors"
+11 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+12 QUIT
+13 ;
EXT ;
+1 IF CT>1
IF $GET(SDABRT)'=1
Begin DoDot:1
+2 IF $EXTRACT(IOST,1,2)="C-"
IF P
NEW DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET SDABRT=1
QUIT
+3 ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
+4 IF $EXTRACT(IOST,1,2)="C-"!P
WRITE @IOF
+5 IF $EXTRACT(THDR,$LENGTH(THDR))=","
SET THDR=$EXTRACT(THDR,1,$LENGTH(THDR)-1)
+6 WRITE $SELECT(SCOPT=2:"Unbilled (SC to NSC)",1:"Billable (NSC to SC)")_" Amounts Report",?90,"Run Date: ",SDRUN,?124,"Page ",$JUSTIFY(P,3)
+7 WRITE !,"*** Report reflects ONLY reviewed encounters ***"
+8 WRITE !!,"By Division(s) "_THDR
+9 WRITE !,?65,"Instit $",?75,"Profess $"
+10 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+11 SET DIV=""
FOR
SET DIV=$ORDER(DITOT(DIV))
if DIV=""
QUIT
Begin DoDot:2
+12 WRITE !,?20,DIV,?65,$JUSTIFY(DITOT(DIV),0,2),?75,$JUSTIFY(DPTOT(DIV),0,2)
+13 SET TOTAI=TOTAI+DITOT(DIV)
SET TOTAP=TOTAP+DPTOT(DIV)
+14 QUIT
End DoDot:2
+15 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+16 WRITE !,?20,"TOTAL",?65,$JUSTIFY(TOTAI,0,2),?75,$JUSTIFY(TOTAP,0,2)
+17 QUIT
End DoDot:1
+18 DO RPTEND^SDSCRPT1
+19 ;
END ; Exit tag
+1 KILL SDBILL,SDLI,SDNAME,APER,SDSUPER,DIV,POP,P,L,SDABRT,DFN,TOTAI,TOTAP
+2 KILL SDLEDT,SDRUN,SDEDT,SDOE,SDOEDT,SDSCTDT,SDSCBDT,SDSCEDT
+3 KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,SCLN
DO KVA^VADPT
+4 QUIT
